;;; edebug.el --- a source-level debugger for Emacs Lisp
-;; Copyright (C) 1988, 89, 90, 91, 92, 93, 94, 95, 97, 1999
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1999,
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <dlaliberte@gte.com>
+;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Maintainer: FSF
;; Keywords: lisp, tools, maint
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; 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.
+;; "?" 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:
;; GTE Labs
;; 40 Sylvan Rd
;; Waltham, MA 02254
-;; dlaliberte@gte.com
+;; liberte@holonexus.org
;;; Code:
-(defconst edebug-version
- (concat "In Emacs version " emacs-version))
-
;;; Bug reporting
-(defconst edebug-maintainer-address "bug-gnu-emacs@gnu.org")
-
-(defun edebug-submit-bug-report ()
- "Submit, via mail, a bug report on edebug."
- (interactive)
- (require 'reporter)
- (and (y-or-n-p "Do you really want to submit a report on edebug? ")
- (reporter-submit-bug-report
- edebug-maintainer-address
- (concat "edebug.el " edebug-version)
- (list 'edebug-setup-hook
- 'edebug-all-defs
- 'edebug-all-forms
- 'edebug-eval-macro-args
- 'edebug-save-windows
- 'edebug-save-displayed-buffer-points
- 'edebug-initial-mode
- 'edebug-trace
- 'edebug-test-coverage
- 'edebug-continue-kbd-macro
- 'edebug-print-length
- 'edebug-print-level
- 'edebug-print-circle
- ))))
+(defalias 'edebug-submit-bug-report 'report-emacs-bug)
;;; Options
(defgroup edebug nil
- "A source-level debugger for Emacs Lisp"
+ "A source-level debugger for Emacs Lisp."
:group 'lisp)
;;;###autoload
(defcustom edebug-all-defs nil
- "*If non-nil, evaluation of any defining forms will instrument for Edebug.
+ "*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'.
:group 'edebug)
(defcustom edebug-eval-macro-args nil
- "*Non-nil means all macro call arguments may be evaluated.
+ "*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.
+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'."
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.
+restored.
`edebug-toggle-save-windows' may be used to change this variable."
:type '(choice boolean (repeat string))
:group 'edebug)
(defcustom edebug-initial-mode 'step
- "*Initial execution mode for Edebug, if non-nil. If this variable
-is non-@code{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."
+ "*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)
(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.
+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'."
(defcustom edebug-print-length 50
- "*Default value of `print-length' to use while printing results in Edebug."
+ "*Default value of `print-length' for printing results in Edebug."
:type 'integer
:group 'edebug)
(defcustom edebug-print-level 50
- "*Default value of `print-level' to use while printing results in Edebug."
+ "*Default value of `print-level' for printing results in Edebug."
:type 'integer
:group 'edebug)
(defcustom edebug-print-circle t
- "*Default value of `print-circle' to use while printing results in Edebug."
+ "*Default value of `print-circle' for printing results in Edebug."
:type 'boolean
:group 'edebug)
;;;###autoload
(defmacro def-edebug-spec (symbol spec)
- "Set the edebug-form-spec property of SYMBOL according to SPEC.
+ "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
\(naming a function), or a list."
`(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
(defmacro def-edebug-form-spec (symbol spec-form)
- "For compatibility with old version. Use `def-edebug-spec' instead."
- (message "Obsolete: use def-edebug-spec instead.")
+ "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.
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
(setq newsymbol (make-symbol newname))))
newsymbol))
-;; Only used by CL-like code.
-(defun edebug-keywordp (object)
- "Return t if OBJECT is a keyword.
-A keyword is a symbol that starts with `:'."
- (and (symbolp object)
- (= ?: (aref (symbol-name object) 0))))
-
(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 `&'."
(defun edebug-window-list ()
"Return a list of windows, in order of `next-window'."
;; This doesn't work for epoch.
- (let* ((first-window (selected-window))
- (window-list (list first-window))
- (next (next-window first-window)))
- (while (not (eq next first-window))
- (setq window-list (cons next window-list))
- (setq next (next-window next)))
+ (let (window-list)
+ (walk-windows (lambda (w) (push w window-list)))
(nreverse window-list)))
-(defun edebug-window-live-p (window)
- "Return non-nil if WINDOW is visible."
- (let* ((first-window (selected-window))
- (next (next-window first-window t)))
- (while (not (or (eq next window)
- (eq next first-window)))
- (setq next (next-window next t)))
- (eq next window)))
-
;; Not used.
'(defun edebug-two-window-p ()
"Return t if there are two windows."
(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))
- (edebug-functionp (cdr object)))
- object))
-
-(defun edebug-functionp (object)
- "Returns the function named by OBJECT, or nil if it is not a function."
- (setq object (edebug-lookup-function object))
- (if (or (subrp object)
- (byte-code-function-p object)
- (and (listp object)
- (eq (car object) 'lambda)
- (listp (car (cdr object)))))
+ (functionp (cdr object)))
object))
(defun edebug-sort-alist (alist function)
(defun edebug-pop-to-buffer (buffer &optional window)
;; Like pop-to-buffer, but select window where BUFFER was last shown.
- ;; Select WINDOW if it provided and it still exists. Otherwise,
+ ;; Select WINDOW if it provided and it still exists. Otherwise,
;; if buffer is currently shown in several windows, choose one.
;; Otherwise, find a new window, possibly splitting one.
(setq window (if (and (windowp window) (edebug-window-live-p window)
(defun edebug-get-displayed-buffer-points ()
;; Return a list of buffer point pairs, for all displayed buffers.
- (save-excursion
- (let* ((first-window (selected-window))
- (next (next-window first-window))
- (buffer-point-list nil)
- buffer)
- (while (not (eq next first-window))
- (set-buffer (setq buffer (window-buffer next)))
- (setq buffer-point-list
- (cons (cons buffer (point)) buffer-point-list))
- (setq next (next-window next)))
- buffer-point-list)))
+ (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.
- (let ((current-buffer (current-buffer)))
- (mapcar (function (lambda (buf-point)
- (if (buffer-name (car buf-point)) ; still exists
- (progn
- (set-buffer (car buf-point))
- (goto-char (cdr buf-point))))))
- buffer-points)
- (set-buffer current-buffer)))
+ (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.
(defun edebug-set-windows (window-info)
;; Set either a full window configuration or some window information.
(if (listp window-info)
- (mapcar (function
+ (mapcar (function
(lambda (one-window-info)
(if one-window-info
- (apply (function
+ (apply (function
(lambda (window buffer point start hscroll)
(if (edebug-window-live-p window)
(progn
(defun edebug-eval-defun (edebug-it)
"Evaluate the top-level form containing point, or after point.
-This version, from Edebug, has the following differences: With a
-prefix argument instrument the code for Edebug. If `edebug-all-defs' is
-non-nil, then the code is instrumented *unless* there is a prefix
-argument. If instrumenting, it prints: `Edebug: FUNCTIONNAME'.
-Otherwise, it prints in the minibuffer."
+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)
(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.
- (setq form (cons 'defconst (cdr form))))
+ (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)))))
+ (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)
;;;###autoload
(defun edebug-eval-top-level-form ()
- "Evaluate a top level form, such as a defun or defmacro.
-This is like `eval-defun', but the code is always instrumented for Edebug.
-Print its name in the minibuffer and leave point where it is,
-or if an error occurs, leave point after it with mark at the original point."
+ "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
+ (eval-expression
;; Bind edebug-all-forms only while reading, not while evalling
;; but this causes problems while edebugging edebug.
(let ((edebug-all-forms t)
;; 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."
+ (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."
+ (message "Edebugging all forms is %s."
(if edebug-all-forms "on" "off")))
;;; Edebug internal data
;; The internal data that is needed for edebugging is kept in the
-;; buffer-local variable `edebug-form-data'.
+;; buffer-local variable `edebug-form-data'.
(make-variable-buffer-local 'edebug-form-data)
-(defconst edebug-form-data nil)
+(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
(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.
+;; 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) ;
+ ;; 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)
(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-vector 256 'symbol))
+ (let ((table (make-char-table 'syntax-table 'symbol))
(i 0))
(while (< i ?!)
(aset table i 'space)
(if (and (eq (following-char) ?.)
(save-excursion
(forward-char 1)
- (and (>= (following-char) ?0)
- (<= (following-char) ?9))))
+ (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))))
;; Leave point before the next token, skipping white space and comments.
(skip-chars-forward " \t\r\n\f")
(while (= (following-char) ?\;)
- ;; \r is counted as a comment terminator to support selective display.
- (skip-chars-forward "^\n\r") ; skip the comment
+ (skip-chars-forward "^\n") ; skip the comment
(skip-chars-forward " \t\r\n\f")))
;; or for structures that have elements: (before <subexpressions> . after)
;; where the <subexpressions> are the offset structures for subexpressions
;; including the head of a list.
-(defconst edebug-offsets nil)
+(defvar edebug-offsets nil)
;; Stack of offset structures in reverse order of the nesting.
;; This is used to get back to previous levels.
-(defconst edebug-offsets-stack nil)
-(defconst edebug-current-offset nil) ; Top of the stack, for convenience.
+(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.
-(defconst edebug-read-dotted-list nil)
+(defvar edebug-read-dotted-list nil)
(defsubst edebug-initialize-offsets ()
;; Reinitialize offset recording.
;; 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
+ ;; 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)))
;; Ignore the last created offset pair.
(setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))
-(def-edebug-spec edebug-storing-offsets (form body))
-(put 'edebug-storing-offsets 'lisp-indent-hook 1)
-
(defmacro edebug-storing-offsets (point &rest body)
+ (declare (debug (form body)) (indent 1))
`(unwind-protect
- (progn
+ (progn
(edebug-store-before-offset ,point)
- ,@body)
+ ,@body)
(edebug-store-after-offset (point))))
))
(defun edebug-read-storing-offsets (stream)
- (let ((class (edebug-next-token-class))
- func
- edebug-read-dotted-list) ; see edebug-store-after-offset
+ (let (edebug-read-dotted-list) ; see edebug-store-after-offset
(edebug-storing-offsets (point)
- (if (setq func (assq class edebug-read-alist))
- (funcall (cdr func) stream)
- ;; anything else, just read it.
- (edebug-original-read stream))
- )))
+ (funcall
+ (or (cdr (assq (edebug-next-token-class) edebug-read-alist))
+ ;; anything else, just read it.
+ 'edebug-original-read)
+ stream))))
(defun edebug-read-symbol (stream)
(edebug-original-read stream))
;; Turn 'thing into (quote thing)
(forward-char 1)
(list
- (edebug-storing-offsets (point) 'quote)
+ (edebug-storing-offsets (1- (point)) 'quote)
(edebug-read-storing-offsets stream)))
+(defvar edebug-read-backquote-level 0
+ "If non-zero, we're in a new-style backquote.
+It should never be negative. This controls how we read comma constructs.")
+
(defun edebug-read-backquote (stream)
;; Turn `thing into (\` thing)
- (let ((opoint (point)))
- (forward-char 1)
- ;; Generate the same structure of offsets we would have
- ;; if the resulting list appeared verbatim in the input text.
- (edebug-storing-offsets opoint
- (list
- (edebug-storing-offsets opoint '\`)
- (edebug-read-storing-offsets stream)))))
-
-(defvar edebug-read-backquote-new nil
- "Non-nil if reading the inside of a new-style backquote with no parens around it.
-Value of nil means reading the inside of an old-style backquote construct
-which is surrounded by an extra set of parentheses.
-This controls how we read comma constructs.")
+ (forward-char 1)
+ (list
+ (edebug-storing-offsets (1- (point)) '\`)
+ (let ((edebug-read-backquote-level (1+ edebug-read-backquote-level)))
+ (edebug-read-storing-offsets stream))))
(defun edebug-read-comma (stream)
;; Turn ,thing into (\, thing). Handle ,@ and ,. also.
(forward-char 1)))
;; Generate the same structure of offsets we would have
;; if the resulting list appeared verbatim in the input text.
- (if edebug-read-backquote-new
- (list
- (edebug-storing-offsets opoint symbol)
- (edebug-read-storing-offsets stream))
- (edebug-storing-offsets opoint symbol)))))
+ (if (zerop edebug-read-backquote-level)
+ (edebug-storing-offsets opoint symbol)
+ (list
+ (edebug-storing-offsets opoint symbol)
+ (let ((edebug-read-backquote-level (1- edebug-read-backquote-level)))
+ (edebug-read-storing-offsets stream)))))))
(defun edebug-read-function (stream)
;; Turn #'thing into (function thing)
(forward-char 1)
- (if (/= ?\' (following-char)) (edebug-syntax-error "Bad char"))
- (forward-char 1)
- (list
- (edebug-storing-offsets (point)
- (if (featurep 'cl) 'function* 'function))
- (edebug-read-storing-offsets stream)))
+ (cond ((eq ?\' (following-char))
+ (forward-char 1)
+ (list
+ (edebug-storing-offsets (- (point) 2)
+ (if (featurep 'cl) 'function* 'function))
+ (edebug-read-storing-offsets stream)))
+ ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
+ ?7 ?8 ?9 ?0))
+ (backward-char 1)
+ (edebug-original-read stream))
+ (t (edebug-syntax-error "Bad char after #"))))
(defun edebug-read-list (stream)
(forward-char 1) ; skip \(
- (prog1
+ (prog1
(let ((elements))
(while (not (memq (edebug-next-token-class) '(rparen dot)))
- (if (eq (edebug-next-token-class) 'backquote)
- (let ((edebug-read-backquote-new (not (null elements)))
- (opoint (point)))
- (if edebug-read-backquote-new
- (setq elements (cons (edebug-read-backquote stream) elements))
- (forward-char 1) ; Skip backquote.
- ;; Call edebug-storing-offsets here so that we
- ;; produce the same offsets we would have had
- ;; if the backquote were an ordinary symbol.
- (setq elements (cons (edebug-storing-offsets opoint '\`)
- elements))))
- (setq elements (cons (edebug-read-storing-offsets stream) elements))))
+ (if (and (eq (edebug-next-token-class) 'backquote)
+ (null elements)
+ (zerop edebug-read-backquote-level))
+ (progn
+ ;; Old style backquote.
+ (forward-char 1) ; Skip backquote.
+ ;; Call edebug-storing-offsets here so that we
+ ;; produce the same offsets we would have had
+ ;; if the backquote were an ordinary symbol.
+ (push (edebug-storing-offsets (1- (point)) '\`) elements))
+ (push (edebug-read-storing-offsets stream) elements)))
(setq elements (nreverse elements))
(if (eq 'dot (edebug-next-token-class))
(let (dotted-form)
(defun edebug-read-vector (stream)
(forward-char 1) ; skip \[
- (prog1
+ (prog1
(let ((elements))
(while (not (eq 'rbracket (edebug-next-token-class)))
- (setq elements (cons (edebug-read-storing-offsets stream) elements)))
+ (push (edebug-read-storing-offsets stream) elements))
(apply 'vector (nreverse elements)))
(forward-char 1) ; skip \]
))
(defun edebug-new-cursor (expressions offsets)
;; Return a new cursor for EXPRESSIONS with OFFSETS.
- (if (vectorp expressions)
+ (if (vectorp expressions)
(setq expressions (append expressions nil)))
(cons expressions offsets))
(setcdr cursor offsets)
cursor)
-'(defun edebug-copy-cursor (cursor)
+(defun edebug-copy-cursor (cursor)
;; Copy the cursor using the same object and offsets.
(cons (car cursor) (cdr cursor)))
;; This is a violation of the cursor encapsulation, but
;; there is plenty of that going on while matching.
;; The following test should always fail.
- (if (edebug-empty-cursor cursor)
+ (if (edebug-empty-cursor cursor)
(edebug-no-match cursor "Not enough arguments."))
(setcar cursor (cdr (car cursor)))
(setcdr cursor (cdr (cdr cursor)))
(defun edebug-before-offset (cursor)
;; Return the before offset of the cursor.
;; If there is nothing left in the offsets,
- ;; return one less than the offset itself,
+ ;; return one less than the offset itself,
;; which is the after offset for a list.
(let ((offset (edebug-cursor-offsets cursor)))
(if (consp offset)
(defvar edebug-&rest)
(defvar edebug-gate nil) ;; whether no-match forces an error.
-(defconst edebug-def-name nil) ; name of definition, used by interactive-form
-(defconst edebug-old-def-name nil) ; previous name of containing definition.
+(defvar edebug-def-name nil) ; name of definition, used by interactive-form
+(defvar edebug-old-def-name nil) ; previous name of containing definition.
-(defconst edebug-error-point nil)
-(defconst edebug-best-error nil)
+(defvar edebug-error-point nil)
+(defvar edebug-best-error nil)
(defun edebug-read-and-maybe-wrap-form ()
defining-form-p (and (listp spec)
(eq '&define (car spec)))
;; This is incorrect in general!! But OK most of the time.
- def-name (if (and defining-form-p
+ def-name (if (and defining-form-p
(eq 'name (car (cdr spec)))
(eq 'symbol (edebug-next-token-class)))
(edebug-original-read (current-buffer))))))
(if (or edebug-all-defs edebug-all-forms)
;; If it is a defining form and we are edebugging defs,
;; then let edebug-list-form start it.
- (let ((cursor (edebug-new-cursor
+ (let ((cursor (edebug-new-cursor
(list (edebug-read-storing-offsets (current-buffer)))
(list edebug-offsets))))
(car
(edebug-make-form-wrapper
cursor
- (edebug-before-offset cursor)
+ (edebug-before-offset cursor)
(1- (edebug-after-offset cursor))
(list (cons (symbol-name def-kind) (cdr spec))))))
;; This only works for defs with simple names.
(put def-name 'edebug (point-marker))
;; Also nil out dependent defs.
- '(mapcar (function
+ '(mapcar (function
(lambda (def)
(put def-name 'edebug nil)))
(get def-name 'edebug-dependents))
;; If all forms are being edebugged, explicitly wrap it.
(edebug-all-forms
- (let ((cursor (edebug-new-cursor
+ (let ((cursor (edebug-new-cursor
(list (edebug-read-storing-offsets (current-buffer)))
(list edebug-offsets))))
- (edebug-make-form-wrapper
+ (edebug-make-form-wrapper
cursor
- (edebug-before-offset cursor)
- (edebug-after-offset cursor)
+ (edebug-before-offset cursor)
+ (edebug-after-offset cursor)
nil)))
;; Not a defining form, and not edebugging.
;; since it wraps the list of forms with a call to `edebug-enter'.
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
- (setq edebug-def-name
+ (setq edebug-def-name
(or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
`(edebug-enter
(quote ,edebug-def-name)
- ,(if edebug-inside-func
+ ,(if edebug-inside-func
`(list
;; Doesn't work with more than one def-body!!
;; But the list will just be reversed.
(defvar edebug-form-begin-marker) ; the mark for def being instrumented
-
+
(defvar edebug-offset-index) ; the next available offset index.
(defvar edebug-offset-list) ; the list of offset positions.
(defun edebug-make-before-and-after-form (before-index form after-index)
;; Return the edebug form for the current function at offset BEFORE-INDEX
- ;; given FORM. Looks like:
+ ;; given FORM. Looks like:
;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
;; Also increment the offset index for subsequent use.
- (list 'edebug-after
+ (list 'edebug-after
(list 'edebug-before before-index)
after-index form))
(defun edebug-unwrap (sexp)
"Return the unwrapped SEXP or return it as is if it is not wrapped.
-The SEXP might be the result of wrapping a body, which is a list of
+The SEXP might be the result of wrapping a body, which is a list of
expressions; a `progn' form will be returned enclosing these forms."
(if (consp sexp)
- (cond
+ (cond
((eq 'edebug-after (car sexp))
(nth 3 sexp))
((eq 'edebug-enter (car sexp))
;; Skip the first offset.
(edebug-set-cursor cursor (edebug-cursor-expressions cursor)
(cdr (edebug-cursor-offsets cursor)))
- (edebug-make-form-wrapper
- cursor
+ (edebug-make-form-wrapper
+ cursor
form-begin (1- form-end)
speclist))
;; This is a hack, but I havent figured out a simpler way yet.
(let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end))
;; Set this marker before parsing.
- (edebug-form-begin-marker
- (if form-data-entry
+ (edebug-form-begin-marker
+ (if form-data-entry
(edebug-form-data-begin form-data-entry)
;; Buffer must be current-buffer for this to work:
(set-marker (make-marker) form-begin))))
edebug-def-interactive
edebug-inside-func;; whether wrapped code executes inside a function.
)
-
+
(setq result
(if speclist
(edebug-match cursor speclist)
;; else wrap as an enter-form.
(edebug-make-enter-wrapper (list (edebug-form cursor)))))
-
+
;; Set the name here if it was not set by edebug-make-enter-wrapper.
- (setq edebug-def-name
+ (setq edebug-def-name
(or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
;; Add this def as a dependent of containing def. Buggy.
'(if (and edebug-containing-def-name
(not (get edebug-containing-def-name 'edebug-dependents)))
(put edebug-containing-def-name 'edebug-dependents
- (cons edebug-def-name
- (get edebug-containing-def-name
+ (cons edebug-def-name
+ (get edebug-containing-def-name
'edebug-dependents))))
;; Create a form-data-entry or modify existing entry's markers.
;; In the latter case, pointers to the entry remain eq.
(if (not form-data-entry)
- (setq form-data-entry
+ (setq form-data-entry
(edebug-make-form-data-entry
- edebug-def-name
+ edebug-def-name
edebug-form-begin-marker
;; Buffer must be current-buffer.
(set-marker (make-marker) form-end)
))
- (edebug-set-form-data-entry
+ (edebug-set-form-data-entry
form-data-entry edebug-def-name ;; in case name is changed
form-begin form-end))
(let ((window ;; Find the best window for this buffer.
(or (get-buffer-window (current-buffer))
(selected-window))))
- (setq edebug-top-window-data
+ (setq edebug-top-window-data
(cons window (window-start window)))))
;; Store the edebug data in symbol's property list.
(defun edebug-clear-coverage (name)
- ;; Create initial coverage vector.
+ ;; Create initial coverage vector.
;; Only need one per expression, but it is simpler to use stop points.
- (put name 'edebug-coverage
+ (put name 'edebug-coverage
(make-vector (length edebug-offset-list) 'unknown)))
(defun edebug-form (cursor)
- ;; Return the instrumented form for the following form.
+ ;; Return the instrumented form for the following form.
;; Add the point offsets to the edebug-offset-list for the form.
(let* ((form (edebug-top-element-required cursor "Expected form"))
(offset (edebug-top-offset cursor)))
;; Find out if this is a defining form from first symbol.
;; An indirect spec would not work here, yet.
(if (and (consp spec) (eq '&define (car spec)))
- (edebug-defining-form
- new-cursor
+ (edebug-defining-form
+ new-cursor
(car offset);; before the form
- (edebug-after-offset cursor)
+ (edebug-after-offset cursor)
(cons (symbol-name head) (cdr spec)))
;; Wrap a regular form.
- (edebug-make-before-and-after-form
+ (edebug-make-before-and-after-form
(edebug-inc-offset (car offset))
(edebug-list-form new-cursor)
;; After processing the list form, the new-cursor is left
(cond
;; Check for constant symbols that don't get wrapped.
((or (memq form '(t nil))
- (and (fboundp 'edebug-keywordp) (edebug-keywordp form)))
+ (keywordp form))
form)
(t ;; just a variable
(edebug-set-cursor cursor (edebug-cursor-expressions cursor)
(cdr (edebug-cursor-offsets cursor)))
(cond
- ((null head) nil) ; () is legal.
-
((symbolp head)
(cond
- ((null head)
- (edebug-syntax-error "nil head"))
+ ((null head) nil) ; () is legal.
((eq head 'interactive-p)
;; Special case: replace (interactive-p) with variable
(setq edebug-def-interactive 'check-it)
(edebug-move-cursor cursor)
(edebug-interactive-p-name))
(t
- (cons head (edebug-list-form-args
+ (cons head (edebug-list-form-args
head (edebug-move-cursor cursor))))))
((consp head)
- (if (and (listp head) (eq (car head) ',))
+ (if (eq (car head) ',)
+ ;; The head of a form should normally be a symbol or a lambda
+ ;; expression but it can also be an unquote form to be filled
+ ;; before evaluation. We evaluate the arguments anyway, on the
+ ;; assumption that the unquote form will place a proper function
+ ;; name (rather than a macro name).
(edebug-match cursor '(("," def-form) body))
;; Process anonymous function and args.
;; This assumes no anonymous macros.
(edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs)))
(t (edebug-syntax-error
- "Head of list form must be a symbol or lambda expression.")))
+ "Head of list form must be a symbol or lambda expression")))
))
;;; Matching of specs.
(defconst edebug-max-depth 150) ;; maximum number of matching recursions.
-;;; Failure to match
+;;; Failure to match
;; This throws to no-match, if there are higher alternatives.
;; Otherwise it signals an error. The place of the error is found
(defun edebug-match-specs (cursor specs remainder-handler)
;; Append results of matching the list of specs.
;; The first spec is handled and the remainder-handler handles the rest.
- (let ((edebug-matching-depth
+ (let ((edebug-matching-depth
(if (> edebug-matching-depth edebug-max-depth)
(error "too deep - perhaps infinite loop in spec?")
(1+ edebug-matching-depth))))
(cond
((null specs) nil)
-
+
;; Is the spec dotted?
- ((atom specs)
+ ((atom specs)
(let ((edebug-dotted-spec t));; Containing spec list was dotted.
(edebug-match-specs cursor (list specs) remainder-handler)))
(t;; Process normally.
(let* ((spec (car specs))
- (rest)
+ (rest)
(first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
;;(message "spec = %s first char = %s" spec first-char) (sit-for 1)
(nconc
;; user may want to define macros or functions with the same names.
;; We could use an internal obarray for these primitive specs.
-(mapcar
- (function (lambda (pair)
- (put (car pair) 'edebug-form-spec (cdr pair))))
- '((&optional . edebug-match-&optional)
- (&rest . edebug-match-&rest)
- (&or . edebug-match-&or)
- (form . edebug-match-form)
- (sexp . edebug-match-sexp)
- (body . edebug-match-body)
- (&define . edebug-match-&define)
- (name . edebug-match-name)
- (:name . edebug-match-colon-name)
- (arg . edebug-match-arg)
- (def-body . edebug-match-def-body)
- (def-form . edebug-match-def-form)
- ;; Less frequently used:
- ;; (function . edebug-match-function)
- (lambda-expr . edebug-match-lambda-expr)
- (¬ . edebug-match-¬)
- (&key . edebug-match-&key)
- (place . edebug-match-place)
- (gate . edebug-match-gate)
- ;; (nil . edebug-match-nil) not this one - special case it.
- ))
+(dolist (pair '((&optional . edebug-match-&optional)
+ (&rest . edebug-match-&rest)
+ (&or . edebug-match-&or)
+ (form . edebug-match-form)
+ (sexp . edebug-match-sexp)
+ (body . edebug-match-body)
+ (&define . edebug-match-&define)
+ (name . edebug-match-name)
+ (:name . edebug-match-colon-name)
+ (arg . edebug-match-arg)
+ (def-body . edebug-match-def-body)
+ (def-form . edebug-match-def-form)
+ ;; Less frequently used:
+ ;; (function . edebug-match-function)
+ (lambda-expr . edebug-match-lambda-expr)
+ (¬ . edebug-match-¬)
+ (&key . edebug-match-&key)
+ (place . edebug-match-place)
+ (gate . edebug-match-gate)
+ ;; (nil . edebug-match-nil) not this one - special case it.
+ ))
+ (put (car pair) 'edebug-form-spec (cdr pair)))
(defun edebug-match-symbol (cursor symbol)
;; Match a symbol spec.
(let* ((spec (get-edebug-spec symbol)))
(cond
- (spec
+ (spec
(if (consp spec)
;; It is an indirect spec.
(edebug-match cursor spec)
;; Otherwise it should be the symbol name of a function.
;; There could be a bug here - maybe need to do edebug-match bindings.
(funcall spec cursor)))
-
+
((null symbol) ;; special case this.
(edebug-match-nil cursor))
- ((fboundp symbol) ; is it a predicate?
+ ((fboundp symbol) ; is it a predicate?
(let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
;; Special case for edebug-`.
(if (and (listp sexp) (eq (car sexp) ',))
(if (null specs) (setq specs edebug-&rest))
;; Reuse the &optional handler with this as the remainder handler.
(edebug-&optional-wrapper cursor specs remainder-handler))
-
+
(defun edebug-match-&rest (cursor specs)
;; Repeatedly use specs until failure.
(let ((edebug-&rest specs) ;; remember these
(edebug-no-match cursor "Unexpected"))
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-
+
(def-edebug-spec &key edebug-match-&key)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
- (edebug-match-&rest
+ (edebug-match-&rest
cursor
- (cons '&or
+ (cons '&or
(mapcar (function (lambda (pair)
- (vector (format ":%s" (car pair))
+ (vector (format ":%s" (car pair))
(car (cdr pair)))))
specs))))
(defun edebug-match-list (cursor specs)
;; The spec is a list, but what kind of list, and what context?
(if edebug-dotted-spec
- ;; After dotted spec but form did not contain dot,
+ ;; After dotted spec but form did not contain dot,
;; so match list spec elements as if spliced in.
(prog1
(let ((edebug-dotted-spec))
(edebug-move-cursor cursor)
(setq edebug-gate t)
form)
- (t
+ (t
(error "Bad spec: %s" specs)))))
((listp form)
(prog1
- (list (edebug-match-sublist
+ (list (edebug-match-sublist
;; First offset is for the list form itself.
;; Treat nil as empty list.
- (edebug-new-cursor form (cdr (edebug-top-offset cursor)))
+ (edebug-new-cursor form (cdr (edebug-top-offset cursor)))
specs))
(edebug-move-cursor cursor)))
((and (eq 'vector spec) (vectorp form))
;; Special case: match a vector with the specs.
(let ((result (edebug-match-sublist
- (edebug-new-cursor
+ (edebug-new-cursor
form (cdr (edebug-top-offset cursor)))
(cdr specs))))
(edebug-move-cursor cursor)
(list (apply 'vector result))))
-
+
(t (edebug-no-match cursor "Expected" specs)))
)))
;;edebug-best-error
;;edebug-error-point
)
- (prog1
+ (prog1
;; match with edebug-match-specs so edebug-best-error is not bound.
(edebug-match-specs cursor specs 'edebug-match-specs)
(if (not (edebug-empty-cursor cursor))
- (if edebug-best-error
+ (if edebug-best-error
(apply 'edebug-no-match cursor edebug-best-error)
;; A failed &rest or &optional spec may leave some args.
(edebug-no-match cursor "Failed matching" specs)
;; This should only be called inside of a spec list to match the remainder
;; of the current list. e.g. ("lambda" &define args def-body)
(edebug-make-form-wrapper
- cursor
+ cursor
(edebug-before-offset cursor)
;; Find the last offset in the list.
(let ((offsets (edebug-cursor-offsets cursor)))
;; The expression must be a function.
;; This will match any list form that begins with a symbol
;; that has an edebug-form-spec beginning with &define. In
- ;; practice, only lambda expressions should be used.
+ ;; practice, only lambda expressions should be used.
;; I could add a &lambda specification to avoid confusion.
- (let* ((sexp (edebug-top-element-required
+ (let* ((sexp (edebug-top-element-required
cursor "Expected lambda expression"))
(offset (edebug-top-offset cursor))
(head (and (consp sexp) (car sexp)))
(if (and (consp spec) (eq '&define (car spec)))
(prog1
(list
- (edebug-defining-form
+ (edebug-defining-form
(edebug-new-cursor sexp offset)
(car offset);; before the sexp
- (edebug-after-offset cursor)
+ (edebug-after-offset cursor)
(cons (symbol-name head) (cdr spec))))
(edebug-move-cursor cursor))
(edebug-no-match cursor "Expected lambda expression")
(def-edebug-spec def-edebug-spec
;; Top level is different from lower levels.
- (&define :name edebug-spec name
+ (&define :name edebug-spec name
&or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
(def-edebug-spec edebug-spec-list
edebug-spec-list
stringp
[edebug-lambda-list-keywordp &rest edebug-spec]
- ;; [edebug-keywordp gate edebug-spec] ;; need edebug-keywordp for this.
+ [keywordp gate edebug-spec]
edebug-spec-p ;; Including all the special ones e.g. form.
symbolp;; a predicate
))
[&optional ("interactive" interactive)]
def-body))
(def-edebug-spec defmacro
- (&define name lambda-list def-body))
+ (&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
(def-edebug-spec \` (backquote-form))
-;; Supports quotes inside backquotes,
+;; Supports quotes inside backquotes,
;; but only at the top level inside unquotes.
(def-edebug-spec backquote-form
(&or
([&or "," ",@"] &or ("quote" backquote-form) form)
- (backquote-form &rest backquote-form)
+ ;; The simple version:
+ ;; (backquote-form &rest backquote-form)
+ ;; doesn't handle (a . ,b). The straightforward fix:
+ ;; (backquote-form . [&or nil backquote-form])
+ ;; uses up too much stack space.
+ ;; Note that `(foo . ,@bar) is not legal, so we don't need to handle it.
+ (backquote-form [&rest [¬ ","] backquote-form]
+ . [&or nil backquote-form])
;; If you use dotted forms in backquotes, replace the previous line
;; with the following. This takes quite a bit more stack space, however.
;; (backquote-form . [&or nil backquote-form])
(def-edebug-spec edebug-\` (def-form))
;; Assume immediate quote in unquotes mean backquote at next higher level.
-(def-edebug-spec , (&or ("quote" edebug-`) def-form))
+(def-edebug-spec , (&or ("quote" edebug-\`) def-form))
(def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped.
- &or ("quote" edebug-`) def-form))
+ &or ("quote" edebug-\`) def-form))
;; New byte compiler.
(def-edebug-spec defsubst defun)
(def-edebug-spec save-selected-window t)
(def-edebug-spec save-current-buffer t)
-(def-edebug-spec save-match-data t)
-(def-edebug-spec with-output-to-string t)
-(def-edebug-spec with-current-buffer t)
-(def-edebug-spec combine-after-change-calls t)
+(def-edebug-spec delay-mode-hooks t)
(def-edebug-spec with-temp-file t)
-(def-edebug-spec with-temp-buffer t)
(def-edebug-spec with-temp-message t)
+(def-edebug-spec with-syntax-table t)
+(def-edebug-spec push (form sexp))
+(def-edebug-spec pop (sexp))
+
+(def-edebug-spec 1value (form))
+(def-edebug-spec noreturn (form))
+
;; Anything else?
;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
(def-edebug-spec ad-dolist ((symbolp form &optional form) body))
-(def-edebug-spec defadvice
+(def-edebug-spec defadvice
(&define name ;; thing being advised.
- (name ;; class is [&or "before" "around" "after"
- ;; "activation" "deactivation"]
+ (name ;; class is [&or "before" "around" "after"
+ ;; "activation" "deactivation"]
name ;; name of advice
&rest sexp ;; optional position and flags
)
[&optional ("interactive" interactive)]
def-body))
+(def-edebug-spec easy-menu-define (symbolp body))
+
+(def-edebug-spec with-custom-print body)
+
+(def-edebug-spec sregexq (&rest sexp))
+(def-edebug-spec rx (&rest sexp))
+
;;; The debugger itself
(defvar edebug-active nil) ;; Non-nil when edebug is active
(defun edebug-enter (edebug-function edebug-args edebug-body)
;; Entering FUNC. The arguments are ARGS, and the body is BODY.
;; Setup edebug variables and evaluate BODY. This function is called
- ;; when a function evaluated with edebug-eval-top-level-form is entered.
+ ;; when a function evaluated with edebug-eval-top-level-form is entered.
;; Return the result of BODY.
;; Is this the first time we are entering edebug since
;; More precisely, this tests whether Edebug is currently active.
(if (not edebug-entered)
(let ((edebug-entered t)
- ;; Binding max-lisp-eval-depth here is OK,
+ ;; Binding max-lisp-eval-depth here is OK,
;; but not inside an unwind-protect.
;; Doing it here also keeps it from growing too large.
(max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
;; Save the outside value of executing macro. (here??)
(edebug-outside-executing-macro executing-kbd-macro)
- (edebug-outside-pre-command-hook pre-command-hook)
- (edebug-outside-post-command-hook post-command-hook))
+ (edebug-outside-pre-command-hook
+ (edebug-var-status 'pre-command-hook))
+ (edebug-outside-post-command-hook
+ (edebug-var-status 'post-command-hook)))
(unwind-protect
(let (;; Don't keep reading from an executing kbd macro
;; within edebug unless edebug-continue-kbd-macro is
;; non-nil. Again, local binding may not be best.
- (executing-kbd-macro
+ (executing-kbd-macro
(if edebug-continue-kbd-macro executing-kbd-macro))
;; Don't get confused by the user's keymap changes.
;; This may be more than we need, however.
(pre-command-hook nil)
(post-command-hook nil))
- (setq edebug-execution-mode (or edebug-next-execution-mode
- edebug-initial-mode
+ (setq edebug-execution-mode (or edebug-next-execution-mode
+ edebug-initial-mode
edebug-execution-mode)
edebug-next-execution-mode nil)
(edebug-enter edebug-function edebug-args edebug-body))
;; Reset global variables in case outside value was changed.
- (setq executing-kbd-macro edebug-outside-executing-macro
- pre-command-hook edebug-outside-pre-command-hook
- post-command-hook edebug-outside-post-command-hook
- )))
-
+ (setq executing-kbd-macro edebug-outside-executing-macro)
+ (edebug-restore-status
+ 'post-command-hook edebug-outside-post-command-hook)
+ (edebug-restore-status
+ 'pre-command-hook edebug-outside-pre-command-hook)))
+
(let* ((edebug-data (get edebug-function 'edebug))
(edebug-def-mark (car edebug-data)) ; mark at def start
(edebug-freq-count (get edebug-function 'edebug-freq-count))
(funcall edebug-body))
)))
+(defun edebug-var-status (var)
+ "Return a cons cell describing the status of VAR's current binding.
+The purpose of this function is so you can properly undo
+subsequent changes to the same binding, by passing the status
+cons cell to `edebug-restore-status'. The status cons cell
+has the form (LOCUS . VALUE), where LOCUS can be a buffer
+\(for a buffer-local binding), a frame (for a frame-local binding),
+or nil (if the default binding is current)."
+ (cons (variable-binding-locus var)
+ (symbol-value var)))
+
+(defun edebug-restore-status (var status)
+ "Reset VAR based on STATUS.
+STATUS should be a list you got from `edebug-var-status'."
+ (let ((locus (car status))
+ (value (cdr status)))
+ (cond ((bufferp locus)
+ (if (buffer-live-p locus)
+ (with-current-buffer locus
+ (set var value))))
+ ((framep locus)
+ (modify-frame-parameters locus (list (cons var value))))
+ (t
+ (set var value)))))
(defun edebug-enter-trace (edebug-body)
(let ((edebug-stack-depth (1+ edebug-stack-depth))
edebug-result)
- (edebug-print-trace-before
+ (edebug-print-trace-before
(format "%s args: %s" edebug-function edebug-args))
(prog1 (setq edebug-result (funcall edebug-body))
(edebug-print-trace-after
edebug-result)
(edebug-print-trace-before ,msg)
(prog1 (setq edebug-result (progn ,@body))
- (edebug-print-trace-after
+ (edebug-print-trace-after
(format "%s result: %s" ,msg edebug-result)))))
(defun edebug-print-trace-before (msg)
(defun edebug-slow-before (edebug-before-index)
- ;; Debug current function given BEFORE position.
- ;; Called from functions compiled with edebug-eval-top-level-form.
- ;; Return the before index.
- (setcar edebug-offset-indices edebug-before-index)
-
- ;; Increment frequency count
- (aset edebug-freq-count edebug-before-index
- (1+ (aref edebug-freq-count edebug-before-index)))
-
- (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
- (edebug-input-pending-p))
- (edebug-debugger edebug-before-index 'before nil))
+ (unless edebug-active
+ ;; Debug current function given BEFORE position.
+ ;; Called from functions compiled with edebug-eval-top-level-form.
+ ;; Return the before index.
+ (setcar edebug-offset-indices edebug-before-index)
+
+ ;; Increment frequency count
+ (aset edebug-freq-count edebug-before-index
+ (1+ (aref edebug-freq-count edebug-before-index)))
+
+ (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
+ (edebug-input-pending-p))
+ (edebug-debugger edebug-before-index 'before nil)))
edebug-before-index)
(defun edebug-fast-before (edebug-before-index)
)
(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
- ;; Debug current function given AFTER position and VALUE.
- ;; Called from functions compiled with edebug-eval-top-level-form.
- ;; Return VALUE.
- (setcar edebug-offset-indices edebug-after-index)
-
- ;; Increment frequency count
- (aset edebug-freq-count edebug-after-index
- (1+ (aref edebug-freq-count edebug-after-index)))
- (if edebug-test-coverage (edebug-update-coverage))
-
- (if (and (eq edebug-execution-mode 'Go-nonstop)
- (not (edebug-input-pending-p)))
- ;; Just return result.
+ (if edebug-active
edebug-value
- (edebug-debugger edebug-after-index 'after edebug-value)
- ))
+ ;; Debug current function given AFTER position and VALUE.
+ ;; Called from functions compiled with edebug-eval-top-level-form.
+ ;; Return VALUE.
+ (setcar edebug-offset-indices edebug-after-index)
+
+ ;; Increment frequency count
+ (aset edebug-freq-count edebug-after-index
+ (1+ (aref edebug-freq-count edebug-after-index)))
+ (if edebug-test-coverage (edebug-update-coverage))
+
+ (if (and (eq edebug-execution-mode 'Go-nonstop)
+ (not (edebug-input-pending-p)))
+ ;; Just return result.
+ edebug-value
+ (edebug-debugger edebug-after-index 'after edebug-value)
+ )))
(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
;; Do nothing but return the value.
(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
- ;; Check breakpoints and pending input.
- ;; If edebug display should be updated, call edebug-display.
- ;; Return edebug-value.
- (let* (;; This needs to be here since breakpoints may be changed.
- (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
- (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
- (edebug-break-condition (car (cdr edebug-break-data)))
- (edebug-global-break
- (if edebug-global-break-condition
- (condition-case nil
- (setq edebug-global-break-result
- (eval edebug-global-break-condition))
- (error nil))))
- (edebug-break))
+ (if inhibit-redisplay
+ ;; Don't really try to enter edebug within an eval from redisplay.
+ edebug-value
+ ;; Check breakpoints and pending input.
+ ;; If edebug display should be updated, call edebug-display.
+ ;; Return edebug-value.
+ (let* ( ;; This needs to be here since breakpoints may be changed.
+ (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
+ (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
+ (edebug-break-condition (car (cdr edebug-break-data)))
+ (edebug-global-break
+ (if edebug-global-break-condition
+ (condition-case nil
+ (setq edebug-global-break-result
+ (eval edebug-global-break-condition))
+ (error nil))))
+ (edebug-break))
;;; (edebug-trace "exp: %s" edebug-value)
- ;; Test whether we should break.
- (setq edebug-break
- (or edebug-global-break
- (and edebug-break-data
- (or (not edebug-break-condition)
- (setq edebug-break-result
- (eval edebug-break-condition))))))
- (if (and edebug-break
- (nth 2 edebug-break-data)) ; is it temporary?
- ;; Delete the breakpoint.
- (setcdr edebug-data
- (cons (delq edebug-break-data edebug-breakpoints)
- (cdr (cdr edebug-data)))))
-
- ;; Display if mode is not go, continue, or Continue-fast
- ;; or break, or input is pending,
- (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
- edebug-break
- (edebug-input-pending-p))
- (edebug-display)) ; <--------------- display
-
- edebug-value
- ))
+ ;; Test whether we should break.
+ (setq edebug-break
+ (or edebug-global-break
+ (and edebug-break-data
+ (or (not edebug-break-condition)
+ (setq edebug-break-result
+ (eval edebug-break-condition))))))
+ (if (and edebug-break
+ (nth 2 edebug-break-data)) ; is it temporary?
+ ;; Delete the breakpoint.
+ (setcdr edebug-data
+ (cons (delq edebug-break-data edebug-breakpoints)
+ (cdr (cdr edebug-data)))))
+
+ ;; Display if mode is not go, continue, or Continue-fast
+ ;; or break, or input is pending,
+ (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
+ edebug-break
+ (edebug-input-pending-p))
+ (edebug-display)) ; <--------------- display
+
+ edebug-value
+ )))
;; window-start now stored with each function.
(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
+(defvar edebug-outside-d-c-i-n-s-w) ; outside default-cursor-in-non-selected-windows
(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
(defvar edebug-previous-result nil) ;; Last result returned.
;; Emacs 19 adds an arg to mark and mark-marker.
-(defalias 'edebug-mark 'mark)
(defalias 'edebug-mark-marker 'mark-marker)
(defun edebug-display ()
+ (unless (marker-position edebug-def-mark)
+ ;; The buffer holding the source has been killed.
+ ;; Let's at least show a backtrace so the user can figure out
+ ;; which function we're talking about.
+ (debug))
;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
;; Uses local variables of edebug-enter, edebug-before, edebug-after
;; and edebug-debugger.
(let ((edebug-active t) ; for minor mode alist
+ (edebug-with-timeout-suspend (with-timeout-suspend))
edebug-stop ; should we enter recursive-edit
(edebug-point (+ edebug-def-mark
(aref (nth 2 edebug-data) edebug-offset-index)))
(edebug-outside-mark (edebug-mark))
edebug-outside-windows ; window or screen configuration
edebug-buffer-points
-
+
edebug-eval-buffer ; declared here so we can kill it below
(edebug-eval-result-list (and edebug-eval-list
(edebug-eval-result-list)))
(edebug-outside-o-a-p overlay-arrow-position)
(edebug-outside-o-a-s overlay-arrow-string)
- (edebug-outside-c-i-e-a cursor-in-echo-area))
+ (edebug-outside-c-i-e-a cursor-in-echo-area)
+ (edebug-outside-d-c-i-n-s-w default-cursor-in-non-selected-windows))
(unwind-protect
(let ((overlay-arrow-position overlay-arrow-position)
(overlay-arrow-string overlay-arrow-string)
(cursor-in-echo-area nil)
+ (default-cursor-in-non-selected-windows t)
;; any others??
)
(if (not (buffer-name edebug-buffer))
(let ((debug-on-error nil))
(error "Buffer defining %s not found" edebug-function)))
-
+
(if (eq 'after edebug-arg-mode)
;; Compute result string now before windows are modified.
(edebug-compute-previous-result edebug-value))
(if edebug-save-windows
;; Save windows now before we modify them.
- (setq edebug-outside-windows
+ (setq edebug-outside-windows
(edebug-current-windows edebug-save-windows)))
-
+
(if edebug-save-displayed-buffer-points
(setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
(setcar edebug-window-data (selected-window))
;; Now display eval list, if any.
- ;; This is done after the pop to edebug-buffer
+ ;; This is done after the pop to edebug-buffer
;; so that buffer-window correspondence is correct after quitting.
(edebug-eval-display edebug-eval-result-list)
;; The evaluation list better not have deleted edebug-window-data.
(setq edebug-buffer-outside-point (point))
(goto-char edebug-point)
-
+
(if (eq 'before edebug-arg-mode)
;; Check whether positions are up-to-date.
;; This assumes point is never before symbol.
(if (not (memq (following-char) '(?\( ?\# ?\` )))
(let ((debug-on-error nil))
- (error "Source has changed - reevaluate definition of %s"
+ (error "Source has changed - reevaluate definition of %s"
edebug-function)
)))
(setcdr edebug-window-data
(edebug-adjust-window (cdr edebug-window-data)))
-
+
;; Test if there is input, not including keyboard macros.
- (if (edebug-input-pending-p)
+ (if (edebug-input-pending-p)
(progn
(setq edebug-execution-mode 'step
edebug-stop t)
))
;; Now display arrow based on mode.
(edebug-overlay-arrow)
-
+
(cond
((eq 'error edebug-arg-mode)
;; Display error message
(edebug-break
(cond
(edebug-global-break
- (message "Global Break: %s => %s"
+ (message "Global Break: %s => %s"
edebug-global-break-condition
edebug-global-break-result))
(edebug-break-condition
- (message "Break: %s => %s"
- edebug-break-condition
+ (message "Break: %s => %s"
+ edebug-break-condition
edebug-break-result))
((not (eq edebug-execution-mode 'Continue-fast))
(message "Break"))
;; Display result of previous evaluation.
(if (and edebug-break
(not (eq edebug-execution-mode 'Continue-fast)))
- (sit-for 1)) ; Show break message.
+ (edebug-sit-for edebug-sit-for-seconds)) ; Show message.
(edebug-previous-result)))
-
+
(cond
(edebug-break
(cond
- ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
+ ((eq edebug-execution-mode 'continue)
+ (edebug-sit-for edebug-sit-for-seconds))
((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
(t (setq edebug-stop t))))
;; not edebug-break
((eq edebug-execution-mode 'Trace-fast)
(edebug-sit-for 0)) ; Force update and continue.
)
-
+
(unwind-protect
(if (or edebug-stop
(memq edebug-execution-mode '(step next))
- (eq edebug-arg-mode 'error))
+ (eq edebug-arg-mode 'error))
(progn
;; (setq edebug-execution-mode 'step)
;; (edebug-overlay-arrow) ; This doesn't always show up.
(setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
(if edebug-trace-window
(setq edebug-trace-window-start
- (and edebug-trace-window
+ (and edebug-trace-window
(window-start edebug-trace-window))))
;; Restore windows before continuing.
;; Unrestore trace window's window-point.
(if edebug-trace-window
- (set-window-start edebug-trace-window
+ (set-window-start edebug-trace-window
edebug-trace-window-start))
;; Unrestore edebug-buffer's window-start, if displayed.
(let ((window (car edebug-window-data)))
- (if (and window (edebug-window-live-p window)
+ (if (and window (edebug-window-live-p window)
(eq (window-buffer) edebug-buffer))
(progn
- (set-window-start window (cdr edebug-window-data)
+ (set-window-start window (cdr edebug-window-data)
'no-force)
;; Unrestore edebug-buffer's window-point.
;; Needed in addition to setting the buffer point
;; None of the following is done if quit or signal occurs.
;; Restore edebug-buffer's outside point.
- ;; (edebug-trace "restore edebug-buffer point: %s"
+ ;; (edebug-trace "restore edebug-buffer point: %s"
;; edebug-buffer-outside-point)
(let ((current-buffer (current-buffer)))
(set-buffer edebug-buffer)
(set-buffer current-buffer))
;; ... nothing more.
)
+ (with-timeout-unsuspend edebug-with-timeout-suspend)
;; Reset global variables to outside values in case they were changed.
(setq
overlay-arrow-position edebug-outside-o-a-p
overlay-arrow-string edebug-outside-o-a-s
- cursor-in-echo-area edebug-outside-c-i-e-a)
+ cursor-in-echo-area edebug-outside-c-i-e-a
+ default-cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
)))
;; Dynamically declared unbound vars
(defvar edebug-outside-match-data) ; match data outside of edebug
(defvar edebug-backtrace-buffer) ; each recursive edit gets its own
-(defvar edebug-inside-windows)
+(defvar edebug-inside-windows)
(defvar edebug-interactive-p)
(defvar edebug-outside-map)
;; Emacs 18
(defvar edebug-outside-unread-command-char)
-;; Lucid Emacs
-(defvar edebug-outside-unread-command-event) ;; like unread-command-events
-(defvar unread-command-event nil)
-
;; Emacs 19.
(defvar edebug-outside-last-command-event)
(defvar edebug-outside-unread-command-events)
(eval-when-compile
(setq edebug-unread-command-char-warning
(get 'unread-command-char 'byte-obsolete-variable))
- (put 'unread-command-char 'byte-obsolete-variable nil)
- (setq edebug-unread-command-event-warning
- (get 'unread-command-event 'byte-obsolete-variable))
- (put 'unread-command-event 'byte-obsolete-variable nil))
+ (put 'unread-command-char 'byte-obsolete-variable nil))
(defun edebug-recursive-edit ()
;; Start up a recursive edit inside of edebug.
(edebug-outside-last-input-event last-input-event)
(edebug-outside-last-command-event last-command-event)
- (edebug-outside-unread-command-event unread-command-event)
(edebug-outside-unread-command-events unread-command-events)
(edebug-outside-last-event-frame last-event-frame)
(edebug-outside-last-nonmenu-event last-nonmenu-event)
;; Declare global values local but using the same global value.
;; We could set these to the values for previous edebug call.
(last-command-char last-command-char)
- (last-command last-command)
+ (last-command last-command)
(this-command this-command)
(last-input-char last-input-char)
;; More for Emacs 19
(last-input-event nil)
(last-command-event nil)
- (unread-command-event nil);; lemacs
(unread-command-events nil)
(last-event-frame nil)
(last-nonmenu-event nil)
(debug-on-quit edebug-outside-debug-on-quit)
;; Don't keep defining a kbd macro.
- (defining-kbd-macro
+ (defining-kbd-macro
(if edebug-continue-kbd-macro defining-kbd-macro))
;; others??
)
- (if (fboundp 'zmacs-deactivate-region);; for lemacs
- (zmacs-deactivate-region))
(if (and (eq edebug-execution-mode 'go)
(not (memq edebug-arg-mode '(after error))))
(message "Break"))
));; inner let
;; Reset global vars to outside values, in case they have been changed.
- (setq
+ (setq
last-command-char edebug-outside-last-command-char
last-command-event edebug-outside-last-command-event
last-command edebug-outside-last-command
this-command edebug-outside-this-command
unread-command-char edebug-outside-unread-command-char
- unread-command-event edebug-outside-unread-command-event
unread-command-events edebug-outside-unread-command-events
current-prefix-arg edebug-outside-current-prefix-arg
last-input-char edebug-outside-last-input-char
(defun edebug-adjust-window (old-start)
;; If pos is not visible, adjust current window to fit following context.
-;;; (message "window: %s old-start: %s window-start: %s pos: %s"
+;;; (message "window: %s old-start: %s window-start: %s pos: %s"
;;; (selected-window) old-start (window-start) (point)) (sit-for 5)
(if (not (pos-visible-in-window-p))
(progn
(beginning-of-line)
(point)))))))
(window-start))
-
+
(defconst edebug-arrow-alist
(defun edebug-overlay-arrow ()
;; Set up the overlay arrow at beginning-of-line in current buffer.
- ;; The arrow string is derived from edebug-arrow-alist and
+ ;; The arrow string is derived from edebug-arrow-alist and
;; edebug-execution-mode.
(let ((pos (save-excursion (beginning-of-line) (point))))
(setq overlay-arrow-string
(setq edebug-inside-windows (edebug-current-windows t))
(edebug-set-windows edebug-outside-windows)
,@body;; Code to change edebug-save-windows
- (setq edebug-outside-windows (edebug-current-windows
+ (setq edebug-outside-windows (edebug-current-windows
edebug-save-windows))
;; Problem: what about outside windows that are deleted inside?
(edebug-set-windows edebug-inside-windows)))
(defun edebug-toggle-save-selected-window ()
- "Toggle the saving and restoring of the selected window.
+ "Toggle the saving and restoring of the selected window.
Also, each time you toggle it on, the inside and outside window
configurations become the same as the current configuration."
(interactive)
(interactive)
(if (not edebug-active)
(error "Edebug is not active"))
- (setq edebug-inside-windows
+ (setq edebug-inside-windows
(edebug-current-windows edebug-save-windows))
(edebug-set-windows edebug-outside-windows)
(goto-char edebug-outside-point)
(save-window-excursion
(edebug-pop-to-buffer edebug-outside-buffer)
(goto-char edebug-outside-point)
- (message "Current buffer: %s Point: %s Mark: %s"
- (current-buffer) (point)
+ (message "Current buffer: %s Point: %s Mark: %s"
+ (current-buffer) (point)
(if (marker-buffer (edebug-mark-marker))
(marker-position (edebug-mark-marker)) "<not set>"))
(edebug-sit-for arg)
(edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
-;; Joe Wells, here is a start at your idea of adding a buffer to the internal
+;; Joe Wells, here is a start at your idea of adding a buffer to the internal
;; display list. Still need to use this list in edebug-display.
'(defvar edebug-display-buffer-list nil
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
(edebug-data (get edebug-def-name 'edebug))
-
+
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
(edebug-breakpoints (car (cdr edebug-data)))
(car edebug-breakpoints)))
(goto-char (+ edebug-def-mark
(aref offset-vector (car breakpoint))))
-
+
(message "%s"
(concat (if (nth 2 breakpoint)
"Temporary " "")
(defun edebug-modify-breakpoint (flag &optional condition temporary)
- "Modify the breakpoint for the form at point or after it according
-to FLAG: set if t, clear if nil. Then move to that point.
+ "Modify the breakpoint for the form at point or after it.
+Set it if FLAG is non-nil, clear it otherwise. Then move to that point.
If CONDITION or TEMPORARY are non-nil, add those attributes to
-the breakpoint. "
+the breakpoint. "
(let ((edebug-stop-point (edebug-find-stop-point)))
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
(edebug-data (get edebug-def-name 'edebug))
-
+
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
(edebug-breakpoints (car (cdr edebug-data)))
(if present
(message "Breakpoint unset in %s" edebug-def-name)
(message "No breakpoint here")))
-
+
(setcar (cdr edebug-data) edebug-breakpoints)
(goto-char (+ edebug-def-mark (aref offset-vector index)))
))))
(edebug-modify-breakpoint nil))
-;; For emacs 18, no read-expression-history
-(defun edebug-set-conditional-breakpoint (arg condition)
- "Set a conditional breakpoint at nearest sexp.
-The condition is evaluated in the outside context.
-With prefix argument, make it a temporary breakpoint."
- ;; (interactive "P\nxCondition: ")
- (interactive
- (list
- current-prefix-arg
- ;; Edit previous condition as follows, but it is cumbersome:
- (let ((edebug-stop-point (edebug-find-stop-point)))
- (if edebug-stop-point
- (let* ((edebug-def-name (car edebug-stop-point))
- (index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
- (edebug-breakpoints (car (cdr edebug-data)))
- (edebug-break-data (assq index edebug-breakpoints))
- (edebug-break-condition (car (cdr edebug-break-data))))
- (read-minibuffer
- (format "Condition in %s: " edebug-def-name)
- (if edebug-break-condition
- (format "%s" edebug-break-condition)
- (format ""))))))))
- (edebug-modify-breakpoint t condition arg))
-
-
(defun edebug-set-global-break-condition (expression)
- (interactive (list (read-minibuffer
- "Global Condition: "
- (format "%s" edebug-global-break-condition))))
+ (interactive
+ (list
+ (let ((initial (and edebug-global-break-condition
+ (format "%s" edebug-global-break-condition))))
+ (read-from-minibuffer
+ "Global Condition: " initial read-expression-map t
+ (if (equal (car read-expression-history) initial)
+ '(read-expression-history . 1)
+ 'read-expression-history)))))
(setq edebug-global-break-condition expression))
(defun edebug-goto-here ()
- "Proceed to this stop point."
+ "Proceed to first stop-point at or after current position of point."
(interactive)
(edebug-go-mode t))
'(defun edebug-forward ()
"Proceed to the exit of the next expression to be evaluated."
(interactive)
- (edebug-set-mode
+ (edebug-set-mode
'forward "Forward"
"Edebug will stop after exiting the next expression."))
(defun edebug-instrument-function (func)
;; Func should be a function symbol.
;; Return the function symbol, or nil if not instrumented.
- (let ((func-marker))
- (setq func-marker (get func 'edebug))
+ (let ((func-marker (get func 'edebug)))
(cond
((markerp func-marker)
;; It is uninstrumented, so instrument it.
- (save-excursion
- (set-buffer (marker-buffer func-marker))
+ (with-current-buffer (marker-buffer func-marker)
(goto-char func-marker)
(edebug-eval-top-level-form)
func))
((consp func-marker)
(message "%s is already instrumented." func)
func)
- (t
- ;; We could try harder, e.g. do a tags search.
- (error "Don't know where %s is defined" func)
- nil))))
+ (t
+ (let ((loc (find-function-noselect func)))
+ (with-current-buffer (car loc)
+ (goto-char (cdr loc))
+ (edebug-eval-top-level-form)
+ func))))))
(defun edebug-instrument-callee ()
- "Instrument the definition of the function or macro about to be called.
+ "Instrument the definition of the function or macro about to be called.
Do this when stopped before the form or it will be too late.
One side effect of using this command is that the next time the
function or macro is called, Edebug will be called there as well."
(defun edebug-step-in ()
- "Step into the definition of the function or macro about to be called.
-This first does `edebug-instrument-callee' to ensure that it is
+ "Step into the definition of the function or macro about to be called.
+This first does `edebug-instrument-callee' to ensure that it is
instrumented. Then it does `edebug-on-entry' and switches to `go' mode."
(interactive)
(let ((func (edebug-instrument-callee)))
(interactive "aEdebug on entry to: ")
(put function 'edebug-on-entry nil))
-
+
(if (not (fboundp 'edebug-original-debug-on-entry))
(fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
'(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this?
Redefining FUNCTION also does that.
This version is from Edebug. If the function is instrumented for
-Edebug, it calls `edebug-on-entry'"
+Edebug, it calls `edebug-on-entry'."
(interactive "aDebug on entry (to function): ")
(let ((func-data (get function 'edebug)))
(if (or (null func-data) (markerp func-data))
`(save-excursion ; of current-buffer
(if edebug-save-windows
(progn
- ;; After excursion, we will
+ ;; After excursion, we will
;; restore to current window configuration.
(setq edebug-inside-windows
(edebug-current-windows edebug-save-windows))
(last-command edebug-outside-last-command)
(this-command edebug-outside-this-command)
(unread-command-char edebug-outside-unread-command-char)
- (unread-command-event edebug-outside-unread-command-event)
(unread-command-events edebug-outside-unread-command-events)
(current-prefix-arg edebug-outside-current-prefix-arg)
(last-input-char edebug-outside-last-input-char)
(executing-kbd-macro edebug-outside-executing-macro)
(defining-kbd-macro edebug-outside-defining-kbd-macro)
- (pre-command-hook edebug-outside-pre-command-hook)
- (post-command-hook edebug-outside-post-command-hook)
+ ;; Get the values out of the saved statuses.
+ (pre-command-hook (cdr edebug-outside-pre-command-hook))
+ (post-command-hook (cdr edebug-outside-post-command-hook))
;; See edebug-display
(overlay-arrow-position edebug-outside-o-a-p)
(overlay-arrow-string edebug-outside-o-a-s)
(cursor-in-echo-area edebug-outside-c-i-e-a)
+ (default-cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
)
(unwind-protect
(save-excursion ; of edebug-buffer
(edebug-set-windows edebug-inside-windows))
;; Save values that may have been changed.
- (setq
+ (setq
edebug-outside-last-command-char last-command-char
edebug-outside-last-command-event last-command-event
edebug-outside-last-command last-command
edebug-outside-this-command this-command
edebug-outside-unread-command-char unread-command-char
- edebug-outside-unread-command-event unread-command-event
edebug-outside-unread-command-events unread-command-events
edebug-outside-current-prefix-arg current-prefix-arg
edebug-outside-last-input-char last-input-char
edebug-outside-executing-macro executing-kbd-macro
edebug-outside-defining-kbd-macro defining-kbd-macro
- edebug-outside-pre-command-hook pre-command-hook
- edebug-outside-post-command-hook post-command-hook
edebug-outside-o-a-p overlay-arrow-position
edebug-outside-o-a-s overlay-arrow-string
edebug-outside-c-i-e-a cursor-in-echo-area
- ))) ; let
+ edebug-outside-d-c-i-n-s-w default-cursor-in-non-selected-windows
+ )
+
+ ;; Restore the outside saved values; don't alter
+ ;; the outside binding loci.
+ (setcdr edebug-outside-pre-command-hook pre-command-hook)
+ (setcdr edebug-outside-post-command-hook post-command-hook)
+
+ )) ; let
))
(defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
(eval edebug-expr)))
(defun edebug-safe-eval (edebug-expr)
- ;; Evaluate EXPR safely.
+ ;; Evaluate EXPR safely.
;; If there is an error, a string is returned describing the error.
(condition-case edebug-err
(edebug-eval edebug-expr)
- (error (edebug-format "%s: %s" ;; could
+ (error (edebug-format "%s: %s" ;; could
(get (car edebug-err) 'error-message)
(car (cdr edebug-err))))))
;; Replace printing functions.
;; obsolete names
-(defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
-(defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
-(defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print)
+(define-obsolete-function-alias 'edebug-install-custom-print-funcs
+ 'edebug-install-custom-print "22.1")
+(define-obsolete-function-alias 'edebug-reset-print-funcs
+ 'edebug-uninstall-custom-print "22.1")
+(define-obsolete-function-alias 'edebug-uninstall-custom-print-funcs
+ 'edebug-uninstall-custom-print "22.1")
(defun edebug-install-custom-print ()
"Replace print functions used by Edebug with custom versions."
(defun edebug-report-error (edebug-value)
;; Print an error message like command level does.
;; This also prints the error name if it has no error-message.
- (message "%s: %s"
+ (message "%s: %s"
(or (get (car edebug-value) 'error-message)
(format "peculiar error (%s)" (car edebug-value)))
- (mapconcat (function (lambda (edebug-arg)
+ (mapconcat (function (lambda (edebug-arg)
;; continuing after an error may
;; complain about edebug-arg. why??
(prin1-to-string edebug-arg)))
(defvar print-level nil)
(defvar print-circle nil)
(defvar print-readably) ;; defined by lemacs
-;; Alternatively, we could change the definition of
+;; Alternatively, we could change the definition of
;; edebug-safe-prin1-to-string to only use these if defined.
(defun edebug-safe-prin1-to-string (value)
(print-level (or edebug-print-level print-level))
(print-circle (or edebug-print-circle print-circle))
(print-readably nil)) ;; lemacs uses this.
- (edebug-prin1-to-string value)))
+ (condition-case nil
+ (edebug-prin1-to-string value)
+ (error "#Apparently circular structure#"))))
(defun edebug-compute-previous-result (edebug-previous-value)
+ (if edebug-unwrap-results
+ (setq edebug-previous-value
+ (edebug-unwrap* edebug-previous-value)))
(setq edebug-previous-result
- (if (and (integerp edebug-previous-value)
- (< edebug-previous-value 256)
- (>= edebug-previous-value 0))
- (format "Result: %s = %s" edebug-previous-value
- (single-key-description edebug-previous-value))
- (if edebug-unwrap-results
- (setq edebug-previous-value
- (edebug-unwrap* edebug-previous-value)))
- (concat "Result: "
- (edebug-safe-prin1-to-string edebug-previous-value)))))
+ (concat "Result: "
+ (edebug-safe-prin1-to-string edebug-previous-value)
+ (eval-expression-print-format edebug-previous-value))))
(defun edebug-previous-result ()
"Print the previous result."
;;; Read, Eval and Print
(defun edebug-eval-expression (edebug-expr)
- "Evaluate an expression in the outside environment.
+ "Evaluate an expression in the outside environment.
If interactive, prompt for the expression.
Print result in minibuffer."
- (interactive "xEval: ")
+ (interactive (list (read-from-minibuffer
+ "Eval: " nil read-expression-map t
+ 'read-expression-history)))
(princ
(edebug-outside-excursion
(setq values (cons (edebug-eval edebug-expr) values))
- (edebug-safe-prin1-to-string (car values)))))
+ (concat (edebug-safe-prin1-to-string (car values))
+ (eval-expression-print-format (car values))))))
(defun edebug-eval-last-sexp ()
- "Evaluate sexp before point in the outside environment;
-print value in minibuffer."
+ "Evaluate sexp before point in the outside environment.
+Print value in minibuffer."
(interactive)
(edebug-eval-expression (edebug-last-sexp)))
(defun edebug-eval-print-last-sexp ()
- "Evaluate sexp before point in the outside environment;
-print value into current buffer."
+ "Evaluate sexp before point in outside environment; insert value.
+This prints the value into current buffer."
(interactive)
(let* ((edebug-form (edebug-last-sexp))
(edebug-result-string
- (edebug-outside-excursion
+ (edebug-outside-excursion
(edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
(standard-output (current-buffer)))
(princ "\n")
(princ "\n")
))
-;;; Edebug Minor Mode
+;;; Edebug Minor Mode
+
+(defvar gud-inhibit-global-bindings
+ "*Non-nil means don't do global rebindings of C-x C-a subcommands.")
;; Global GUD bindings for all emacs-lisp-mode buffers.
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
-
-
-(defvar edebug-mode-map nil)
-(if edebug-mode-map
- nil
- (progn
- (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
+(unless gud-inhibit-global-bindings
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where))
+
+(defvar edebug-mode-map
+ (let ((map (copy-keymap emacs-lisp-mode-map)))
;; control
- (define-key edebug-mode-map " " 'edebug-step-mode)
- (define-key edebug-mode-map "n" 'edebug-next-mode)
- (define-key edebug-mode-map "g" 'edebug-go-mode)
- (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode)
- (define-key edebug-mode-map "t" 'edebug-trace-mode)
- (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode)
- (define-key edebug-mode-map "c" 'edebug-continue-mode)
- (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode)
-
- ;;(define-key edebug-mode-map "f" 'edebug-forward) not implemented
- (define-key edebug-mode-map "f" 'edebug-forward-sexp)
- (define-key edebug-mode-map "h" 'edebug-goto-here)
-
- (define-key edebug-mode-map "I" 'edebug-instrument-callee)
- (define-key edebug-mode-map "i" 'edebug-step-in)
- (define-key edebug-mode-map "o" 'edebug-step-out)
-
+ (define-key map " " 'edebug-step-mode)
+ (define-key map "n" 'edebug-next-mode)
+ (define-key map "g" 'edebug-go-mode)
+ (define-key map "G" 'edebug-Go-nonstop-mode)
+ (define-key map "t" 'edebug-trace-mode)
+ (define-key map "T" 'edebug-Trace-fast-mode)
+ (define-key map "c" 'edebug-continue-mode)
+ (define-key map "C" 'edebug-Continue-fast-mode)
+
+ ;;(define-key map "f" 'edebug-forward) not implemented
+ (define-key map "f" 'edebug-forward-sexp)
+ (define-key map "h" 'edebug-goto-here)
+
+ (define-key map "I" 'edebug-instrument-callee)
+ (define-key map "i" 'edebug-step-in)
+ (define-key map "o" 'edebug-step-out)
+
;; quitting and stopping
- (define-key edebug-mode-map "q" 'top-level)
- (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
- (define-key edebug-mode-map "a" 'abort-recursive-edit)
- (define-key edebug-mode-map "S" 'edebug-stop)
+ (define-key map "q" 'top-level)
+ (define-key map "Q" 'edebug-top-level-nonstop)
+ (define-key map "a" 'abort-recursive-edit)
+ (define-key map "S" 'edebug-stop)
;; breakpoints
- (define-key edebug-mode-map "b" 'edebug-set-breakpoint)
- (define-key edebug-mode-map "u" 'edebug-unset-breakpoint)
- (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
- (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
- (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
-
+ (define-key map "b" 'edebug-set-breakpoint)
+ (define-key map "u" 'edebug-unset-breakpoint)
+ (define-key map "B" 'edebug-next-breakpoint)
+ (define-key map "x" 'edebug-set-conditional-breakpoint)
+ (define-key map "X" 'edebug-set-global-break-condition)
+
;; evaluation
- (define-key edebug-mode-map "r" 'edebug-previous-result)
- (define-key edebug-mode-map "e" 'edebug-eval-expression)
- (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
- (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
-
+ (define-key map "r" 'edebug-previous-result)
+ (define-key map "e" 'edebug-eval-expression)
+ (define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
+ (define-key map "E" 'edebug-visit-eval-list)
+
;; views
- (define-key edebug-mode-map "w" 'edebug-where)
- (define-key edebug-mode-map "v" 'edebug-view-outside) ;; maybe obsolete??
- (define-key edebug-mode-map "p" 'edebug-bounce-point)
- (define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v
- (define-key edebug-mode-map "W" 'edebug-toggle-save-windows)
+ (define-key map "w" 'edebug-where)
+ (define-key map "v" 'edebug-view-outside) ;; maybe obsolete??
+ (define-key map "p" 'edebug-bounce-point)
+ (define-key map "P" 'edebug-view-outside) ;; same as v
+ (define-key map "W" 'edebug-toggle-save-windows)
;; misc
- (define-key edebug-mode-map "?" 'edebug-help)
- (define-key edebug-mode-map "d" 'edebug-backtrace)
-
- (define-key edebug-mode-map "-" 'negative-argument)
+ (define-key map "?" 'edebug-help)
+ (define-key map "d" 'edebug-backtrace)
+
+ (define-key map "-" 'negative-argument)
;; statistics
- (define-key edebug-mode-map "=" 'edebug-temp-display-freq-count)
+ (define-key map "=" 'edebug-temp-display-freq-count)
;; GUD bindings
- (define-key edebug-mode-map "\C-c\C-s" 'edebug-step-mode)
- (define-key edebug-mode-map "\C-c\C-n" 'edebug-next-mode)
- (define-key edebug-mode-map "\C-c\C-c" 'edebug-go-mode)
-
- (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)
- (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)
- (define-key edebug-mode-map "\C-c\C-t"
- (function (lambda () (edebug-set-breakpoint t))))
- (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)
- ))
+ (define-key map "\C-c\C-s" 'edebug-step-mode)
+ (define-key map "\C-c\C-n" 'edebug-next-mode)
+ (define-key map "\C-c\C-c" 'edebug-go-mode)
+
+ (define-key map "\C-x " 'edebug-set-breakpoint)
+ (define-key map "\C-c\C-d" 'edebug-unset-breakpoint)
+ (define-key map "\C-c\C-t"
+ (lambda () (interactive) (edebug-set-breakpoint t)))
+ (define-key map "\C-c\C-l" 'edebug-where)
+ map))
;; Autoloading these global bindings doesn't make sense because
;; they cannot be used anyway unless Edebug is already loaded and active.
(defvar global-edebug-prefix "\^XX"
"Prefix key for global edebug commands, available from any buffer.")
-(defvar global-edebug-map nil
+(defvar global-edebug-map
+ (let ((map (make-sparse-keymap)))
+
+ (define-key map " " 'edebug-step-mode)
+ (define-key map "g" 'edebug-go-mode)
+ (define-key map "G" 'edebug-Go-nonstop-mode)
+ (define-key map "t" 'edebug-trace-mode)
+ (define-key map "T" 'edebug-Trace-fast-mode)
+ (define-key map "c" 'edebug-continue-mode)
+ (define-key map "C" 'edebug-Continue-fast-mode)
+
+ ;; breakpoints
+ (define-key map "b" 'edebug-set-breakpoint)
+ (define-key map "u" 'edebug-unset-breakpoint)
+ (define-key map "x" 'edebug-set-conditional-breakpoint)
+ (define-key map "X" 'edebug-set-global-break-condition)
+
+ ;; views
+ (define-key map "w" 'edebug-where)
+ (define-key map "W" 'edebug-toggle-save-windows)
+
+ ;; quitting
+ (define-key map "q" 'top-level)
+ (define-key map "Q" 'edebug-top-level-nonstop)
+ (define-key map "a" 'abort-recursive-edit)
+
+ ;; statistics
+ (define-key map "=" 'edebug-display-freq-count)
+ map)
"Global map of edebug commands, available from any buffer.")
-(if global-edebug-map
- nil
- (setq global-edebug-map (make-sparse-keymap))
-
- (global-unset-key global-edebug-prefix)
- (global-set-key global-edebug-prefix global-edebug-map)
-
- (define-key global-edebug-map " " 'edebug-step-mode)
- (define-key global-edebug-map "g" 'edebug-go-mode)
- (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode)
- (define-key global-edebug-map "t" 'edebug-trace-mode)
- (define-key global-edebug-map "T" 'edebug-Trace-fast-mode)
- (define-key global-edebug-map "c" 'edebug-continue-mode)
- (define-key global-edebug-map "C" 'edebug-Continue-fast-mode)
-
- ;; breakpoints
- (define-key global-edebug-map "b" 'edebug-set-breakpoint)
- (define-key global-edebug-map "u" 'edebug-unset-breakpoint)
- (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)
- (define-key global-edebug-map "X" 'edebug-set-global-break-condition)
-
- ;; views
- (define-key global-edebug-map "w" 'edebug-where)
- (define-key global-edebug-map "W" 'edebug-toggle-save-windows)
-
- ;; quitting
- (define-key global-edebug-map "q" 'top-level)
- (define-key global-edebug-map "Q" 'edebug-top-level-nonstop)
- (define-key global-edebug-map "a" 'abort-recursive-edit)
-
- ;; statistics
- (define-key global-edebug-map "=" 'edebug-display-freq-count)
- )
+(global-unset-key global-edebug-prefix)
+(global-set-key global-edebug-prefix global-edebug-map)
+
(defun edebug-help ()
(interactive)
In addition to all Emacs Lisp commands (except those that modify the
buffer) there are local and global key bindings to several Edebug
-specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode]
+specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode]
in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
-Also see bindings for the eval list buffer, *edebug*.
+Also see bindings for the eval list buffer *edebug* in `edebug-eval-mode'.
The edebug buffer commands:
\\{edebug-mode-map}
;; Assumes in outside environment.
;; Don't do any edebug things now.
(let ((edebug-execution-mode 'Go-nonstop)
- (edebug-trace nil))
+ (edebug-trace nil))
(mapcar 'edebug-safe-eval edebug-eval-list)))
(defun edebug-eval-display-list (edebug-eval-result-list)
(progn
(forward-sexp 1)
(setq new-list (cons (edebug-last-sexp) new-list))))
-
+
(while (re-search-forward "^;" nil t)
(forward-line 1)
(skip-chars-forward " \t\n\r")
(progn
(forward-sexp 1)
(setq new-list (cons (edebug-last-sexp) new-list)))))
-
+
(setq edebug-eval-list (nreverse new-list))
(edebug-eval-redisplay)
(goto-char starting-point)))
(defvar edebug-eval-mode-map nil
"Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
-(if edebug-eval-mode-map
- nil
- (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
-
+(unless edebug-eval-mode-map
+ (setq edebug-eval-mode-map (make-sparse-keymap))
+ (set-keymap-parent edebug-eval-mode-map lisp-interaction-mode-map)
+
(define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
(define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
(define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
(define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
- (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)
- )
+ (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp))
(put 'edebug-eval-mode 'mode-class 'special)
-(defun edebug-eval-mode ()
+(define-derived-mode edebug-eval-mode lisp-interaction-mode "Edebug Eval"
"Mode for evaluation list buffer while in Edebug.
In addition to all Interactive Emacs Lisp commands there are local and
Eval list buffer commands:
\\{edebug-eval-mode-map}
-Global commands prefixed by global-edebug-prefix:
-\\{global-edebug-map}
-"
- (lisp-interaction-mode)
- (setq major-mode 'edebug-eval-mode)
- (setq mode-name "Edebug Eval")
- (use-local-map edebug-eval-mode-map))
+Global commands prefixed by `global-edebug-prefix':
+\\{global-edebug-map}")
;;; Interface with standard debugger.
;; edebug is not dependent on this, yet.
(defun edebug (&optional edebug-arg-mode &rest debugger-args)
- "Replacement for debug.
+ "Replacement for debug.
If we are running an edebugged function,
show where we last were. Otherwise call debug normally."
;; (message "entered: %s depth: %s edebug-recursion-depth: %s"
(edebug-break (null edebug-arg-mode)) ;; if called explicitly
)
(edebug-display)
- (if (eq edebug-arg-mode 'error)
+ (if (eq edebug-arg-mode 'error)
nil
edebug-value))
last-ok-point)
(backtrace)
- ;; Clean up the backtrace.
+ ;; Clean up the backtrace.
;; Not quite right for current edebug scheme.
(set-buffer edebug-backtrace-buffer)
(setq truncate-lines t)
;; Delete interspersed edebug internals.
(while (re-search-forward "^ \(?edebug" nil t)
(beginning-of-line)
- (cond
+ (cond
((looking-at "^ \(edebug-after")
;; Previous lines may contain code, so just delete this line
(setq last-ok-point (point))
;;; Frequency count and coverage
(defun edebug-display-freq-count ()
- "Display the frequency count data for each line of the current
-definition. The frequency counts are inserted as comment lines after
+ "Display the frequency count data for each line of the current definition.
+The frequency counts are inserted as comment lines after
each line, and you can undo all insertions with one `undo' command.
The counts are inserted starting under the `(' before an expression
last-index i)
;; Find all indexes on same line.
- (while (and (<= 0 (setq i (1- i)))
+ (while (and (<= 0 (setq i (1- i)))
(<= start-of-line (aref edebug-points i))))
;; Insert all the indices for this line.
(forward-line 1)
(goto-char (+ (aref edebug-points i) def-mark))
(- (current-column)
(if (= ?\( (following-char)) 0 1)))))
- (insert (make-string
- (max 0 (- col (- (point) start-of-count-line))) ?\ )
+ (insert (make-string
+ (max 0 (- col (- (point) start-of-count-line))) ?\s)
(if (and (< 0 count)
- (not (memq coverage
+ (not (memq coverage
'(unknown ok-coverage))))
"=" "")
(if (= count last-count) "" (int-to-string count))
(defconst edebug-mode-menus
'("Edebug"
- "----"
["Stop" edebug-stop t]
["Step" edebug-step-mode t]
["Next" edebug-next-mode t]
["Visit Eval List" edebug-visit-eval-list t])
("Options"
- ["Edebug All Defs" edebug-all-defs t]
- ["Edebug All Forms" edebug-all-forms t]
+ ["Edebug All Defs" edebug-all-defs
+ :style toggle :selected edebug-all-defs]
+ ["Edebug All Forms" edebug-all-forms
+ :style toggle :selected edebug-all-forms]
"----"
- ["Toggle Tracing" (edebug-toggle 'edebug-trace) t]
- ["Toggle Coverage Testing" (edebug-toggle 'edebug-test-coverage) t]
- ["Toggle Window Saving" edebug-toggle-save-windows t]
- ["Toggle Point Saving"
- (edebug-toggle 'edebug-save-displayed-buffer-points) t]
+ ["Tracing" (edebug-toggle 'edebug-trace)
+ :style toggle :selected edebug-trace]
+ ["Test Coverage" (edebug-toggle 'edebug-test-coverage)
+ :style toggle :selected edebug-test-coverage]
+ ["Save Windows" edebug-toggle-save-windows
+ :style toggle :selected edebug-save-windows]
+ ["Save Point"
+ (edebug-toggle 'edebug-save-displayed-buffer-points)
+ :style toggle :selected edebug-save-displayed-buffer-points]
))
- "Lemacs style menus for Edebug.")
+ "Menus for Edebug.")
\f
;;; Emacs version specific code
-;;; The default for all above is Emacs 18, because it is easier to compile
-;;; Emacs 18 code in Emacs 19 than vice versa. This default will
-;;; change once most people are using Emacs 19 or derivatives.
-
-;; Epoch specific code is in a separate file: edebug-epoch.el.
+(defalias 'edebug-window-live-p 'window-live-p)
-;; The byte-compiler will complain about changes in number of arguments
-;; to functions like mark and read-from-minibuffer. These warnings
-;; may be ignored because the right call should always be made.
+(defun edebug-mark ()
+ (mark t))
-(defun edebug-emacs-19-specific ()
-
- (defalias 'edebug-window-live-p 'window-live-p)
-
- ;; Mark takes an argument in Emacs 19.
- (defun edebug-mark ()
- (mark t));; Does this work for lemacs too?
-
- (defun edebug-set-conditional-breakpoint (arg condition)
- "Set a conditional breakpoint at nearest sexp.
+(defun edebug-set-conditional-breakpoint (arg condition)
+ "Set a conditional breakpoint at nearest sexp.
The condition is evaluated in the outside context.
With prefix argument, make it a temporary breakpoint."
- ;; (interactive "P\nxCondition: ")
- (interactive
- (list
- current-prefix-arg
- ;; Read condition as follows; getting previous condition is cumbersome:
- (let ((edebug-stop-point (edebug-find-stop-point)))
- (if edebug-stop-point
- (let* ((edebug-def-name (car edebug-stop-point))
- (index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
- (edebug-breakpoints (car (cdr edebug-data)))
- (edebug-break-data (assq index edebug-breakpoints))
- (edebug-break-condition (car (cdr edebug-break-data)))
- (edebug-expression-history
- ;; Prepend the current condition, if any.
- (if edebug-break-condition
- (cons edebug-break-condition read-expression-history)
- read-expression-history)))
- (prog1
- (read-from-minibuffer
- "Condition: " nil read-expression-map t
- 'edebug-expression-history)
- (setq read-expression-history edebug-expression-history)
- ))))))
- (edebug-modify-breakpoint t condition arg))
-
- (defun edebug-eval-expression (edebug-expr)
- "Evaluate an expression in the outside environment.
-If interactive, prompt for the expression.
-Print result in minibuffer."
- (interactive (list (read-from-minibuffer
- "Eval: " nil read-expression-map t
- 'read-expression-history)))
- (princ
- (edebug-outside-excursion
- (setq values (cons (edebug-eval edebug-expr) values))
- (edebug-safe-prin1-to-string (car values)))))
-
- (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
- (if window-system
- (x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug])))
- )
-
-
-(defun edebug-lemacs-specific ()
-
- ;; We need to bind zmacs-regions to nil around all calls to `mark' and
- ;; `mark-marker' but don't bind it to nil before entering a recursive edit,
- ;; that is, don't interfere with the binding the user might see while
- ;; executing a command.
-
- (defvar zmacs-regions)
-
- (defun edebug-mark ()
- (let ((zmacs-regions nil))
- (mark)))
-
- (defun edebug-mark-marker ()
- (let ((zmacs-regions nil));; for lemacs
- (mark-marker)))
-
-
- (defun edebug-mode-menu (event)
- (interactive "@event")
- (popup-menu edebug-mode-menus))
-
- (define-key edebug-mode-map 'button3 'edebug-mode-menu)
- )
-
-(defun edebug-emacs-version-specific ()
- (cond
- ((string-match "Lucid" emacs-version);; Lucid Emacs
- (edebug-lemacs-specific))
-
- ((not (string-match "^18" emacs-version))
- (edebug-emacs-19-specific))))
-
-(edebug-emacs-version-specific)
+ ;; (interactive "P\nxCondition: ")
+ (interactive
+ (list
+ current-prefix-arg
+ ;; Read condition as follows; getting previous condition is cumbersome:
+ (let ((edebug-stop-point (edebug-find-stop-point)))
+ (if edebug-stop-point
+ (let* ((edebug-def-name (car edebug-stop-point))
+ (index (cdr edebug-stop-point))
+ (edebug-data (get edebug-def-name 'edebug))
+ (edebug-breakpoints (car (cdr edebug-data)))
+ (edebug-break-data (assq index edebug-breakpoints))
+ (edebug-break-condition (car (cdr edebug-break-data)))
+ (initial (and edebug-break-condition
+ (format "%s" edebug-break-condition))))
+ (read-from-minibuffer
+ "Condition: " initial read-expression-map t
+ (if (equal (car read-expression-history) initial)
+ '(read-expression-history . 1)
+ 'read-expression-history)))))))
+ (edebug-modify-breakpoint t condition arg))
+(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
\f
;;; Byte-compiler
;; Disabled before edebug-recursive-edit.
(eval-when-compile
(if edebug-unread-command-char-warning
- (put 'unread-command-char 'byte-obsolete-variable
- edebug-unread-command-char-warning))
- (if edebug-unread-command-event-warning
- (put 'unread-command-event 'byte-obsolete-variable
- edebug-unread-command-event-warning)))
+ (put 'unread-command-char 'byte-obsolete-variable
+ edebug-unread-command-char-warning)))
(eval-when-compile
;; The body of eval-when-compile seems to get evaluated with eval-defun.
(defun byte-compile-resolve-functions (funcs)
"Say it is OK for the named functions to be unresolved."
- (mapcar
- (function
+ (mapcar
+ (function
(lambda (func)
(setq byte-compile-unresolved-functions
(delq (assq func byte-compile-unresolved-functions)
byte-compile-unresolved-functions))))
funcs)
nil)
-
+
'(defun byte-compile-resolve-free-references (vars)
"Say it is OK for the named variables to be referenced."
- (mapcar
- (function
+ (mapcar
+ (function
(lambda (var)
(setq byte-compile-free-references
(delq var byte-compile-free-references))))
'(defun byte-compile-resolve-free-assignments (vars)
"Say it is OK for the named variables to be assigned."
- (mapcar
- (function
+ (mapcar
+ (function
(lambda (var)
(setq byte-compile-free-assignments
(delq var byte-compile-free-assignments))))
vars)
nil)
- (byte-compile-resolve-functions
- '(reporter-submit-bug-report
+ (byte-compile-resolve-functions
+ '(reporter-submit-bug-report
edebug-gensym ;; also in cl.el
;; Interfaces to standard functions.
- edebug-original-eval-defun
+ edebug-original-eval-defun
edebug-original-read
edebug-get-buffer-window
edebug-mark
edebug-mark-marker
- edebug-input-pending-p
+ edebug-input-pending-p
edebug-sit-for
- edebug-prin1-to-string
+ edebug-prin1-to-string
edebug-format
;; lemacs
zmacs-deactivate-region
(add-hook 'cl-load-hook
(function (lambda () (require 'cl-specs)))))
-;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
+;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
(if (featurep 'cl-read)
(add-hook 'edebug-setup-hook
(function (lambda () (require 'edebug-cl-read))))
(provide 'edebug)
+;;; arch-tag: 19c8d05c-4554-426e-ac72-e0fa1fcb0808
;;; edebug.el ends here