-;;; edebug.el --- a source-level debugger for Emacs Lispl
+;;; edebug.el --- a source-level debugger for Emacs Lisp
-;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94 Free Software Foundation, Inc
+;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1999,
+;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
+;; Author: Daniel LaLiberte <liberte@holonexus.org>
+;; Maintainer: FSF
;; Keywords: lisp, tools, maint
-;; LCD Archive Entry:
-;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
-;; |A source level debugger for Emacs Lisp.
-;; |$Date: 1994/03/23 20:30:36 $|$Revision: 3.4 $|~/modes/edebug.el|
-
-;; Emacs maintainers: Please inform me of any changes to this code.
-;; Better yet, ask me first.
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;;; Commentary:
-
-;;; This minor mode allows programmers to step through Emacs Lisp
-;;; source code while executing functions. You can also set
-;;; breakpoints, trace (stopping at each expression), evaluate
-;;; expressions as if outside Edebug, reevaluate and display a list of
-;;; expressions, trap errors normally caught by debug, and display a
-;;; debug style backtrace.
-
-;;;; Installation
-;;; =============
-
-;;; Put edebug.el in some directory in your load-path and
-;;; byte-compile it. Also read the beginning of edebug-epoch.el,
-;;; cl-specs.el, and edebug-cl-read.el if they apply to you.
-
-;;; Unless you are using Emacs 19 which is already set up to use Edebug,
-;;; put the following forms in your .emacs file.
-;;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
-;;; (autoload 'edebug-eval-top-level-form "edebug")
-
-;;; If you wish to change the default edebug global command prefix, change:
-;;; (setq edebug-global-prefix "\C-xX")
-
-;;; Other options, are described in the manual.
-
-;;; In previous versions of Edebug, users were directed to set
-;;; `debugger' to `edebug-debug'. This is no longer necessary
-;;; since Edebug automatically sets it whenever Edebug is active.
-
-;;;; Minimal Instructions
-;;; =====================
-
-;;; First evaluate a defun with C-xx, then run the function. Step
-;;; through the code with SPC, mark breakpoints with b, go until a
-;;; breakpoint is reached with g, and quit execution with q. Use the
-;;; "?" command in edebug to describe other commands. See edebug.tex
-;;; or the Emacs 19 Lisp Reference Manual for more instructions.
-
-;;; Send me your enhancements, ideas, bugs, or fixes.
-;;; For bugs, you can call edebug-submit-bug-report if you have reporter.el.
-;;; There is an edebug mailing list if you want to keep up
-;;; with the latest developments. Requests to: edebug-request@cs.uiuc.edu
-
-;;; Daniel LaLiberte 217-398-4114
-;;; University of Illinois, Urbana-Champaign
-;;; Department of Computer Science
-;;; 1304 W Springfield
-;;; Urbana, IL 61801
-
-;;; uiucdcs!liberte
-;;; liberte@cs.uiuc.edu
-
-;;; ===============================
-;;; $Header: /import/kaplan/kaplan/liberte/Edebug/RCS/edebug.el,v 3.4 1994/03/23 20:30:36 liberte Exp liberte $
-;;;
-;;; $Log: edebug.el,v $
-;;; Revision 3.4 1994/03/23 20:30:36 liberte
-;;; * Fixed trapping of handled signals.
-;;; * Stop incrementing max-lisp-eval-depth and max-specpdl-size so much.
-;;; * Change "i" command to really step in; new "I" command only instruments.
-;;; Neither jumps back to current stop point anymore.
-;;; * Added experimental edebug-on-entry and cancel-edebug-on-entry.
-;;; * Always require easymenu, so it byte-compiles correctly.
-;;; * Use elisp-eval-region package, which is also used by cl-read.
-;;; * Simplified edebug-cl-read at the expense of complexifying cl-read.
-;;; * Fix circular load problems with cl-specs and cl-read.
-;;;
-;;; Revision 3.3 1994/02/21 21:35:11 liberte
-;;; * Byte compiles with fewer warnings.
-;;; * Removed support for dotted lists in backquote - it's too expensive.
-;;; * Added edebug-` for debugging backquoted code.
-;;; * Renamed "fence" to "gate" because it inhibits backtracking.
-;;; * Common menus for Emacs 19 and lemacs using easymenus.
-;;; * Support Emacs 19 read-expression-history.
-;;; * Support debugging of lexical bindings from cl.el, version 2.03.
-;;; * Generalize tracing and add macro: edebug-tracing.
-;;; * Correct live window checking.
-;;; * Each definition remembers which window it was last debugged in.
-;;; * Individual windows may be saved and restored.
-;;; * Save and restore Emacs 19 events and mouse tracking.
-;;; * Handled signals may be trapped by Edebug. But disabled for now.
-;;;
-;;; Revision 3.2 1993/09/21 21:06:30 liberte
-;;; * Don't define keywordp if already defined (by cl.el).
-;;; * Clean up docs of edebug versions of eval-defun, eval-region, etc.
-;;; * Add :name spec for specifying additional name components.
-;;; * Replace "Not enough arguments" by what was expected.
-;;; * Replace "Too many arguments" for a list spec to say what was expected.
-;;; * Support &define again in middle of specs, (e.g. cl lambda expressions)
-;;; * Fix "vector" specs to not be order dependent.
-;;; * Simplify and correct spec of def-edebug-spec.
-;;; * Require at least one arg after &optional in lambda-list.
-;;; * Added edebug-cl-read.el to support cl read syntax, using cl-read.el.
-;;; * Allow forms to start with \# and \` as well as \(, for cl-read.
-;;; * Support #' for function quoting, used by lemacs.
-;;; * Make GUD bindings for all emacs-lisp-mode buffers.
-;;;
-;;; Revision 3.1 1993/08/04 16:25:05 liberte
-;;; * For compatability with older version of Edebug, I added
-;;; edebug-all-defuns and def-edebug-form-spec. Dont use them.
-;;; * Fixed bad argument in def-edebug-spec.
-;;; * Only use edebug-print-* options if non-nil.
-;;; * Fixed edebug-display-freq-count.
-;;;
-;;; Revision 3.0 1993/07/17 22:15:39 liberte
-;;; * Added edebug-setup-hook called when edebug is used.
-;;; * Added predicates: keywordp and lambda-list-keywordp.
-;;; * Changed the name of custom-print.el to cust-print.el,
-;;; but Lisp variables and functions still use "custom-".
-;;; * Changed names of replacement eval functions (eval-region, etc) to
-;;; add "edebug-" prefix. Then replace the standard functions
-;;; in edebug-install-eval-functions called at end of file.
-;;; * In edebug-eval-region, bind standard-output only while printing.
-;;; * Change def-edebug-form to def-edebug-spec.
-;;; * Replace the parser to first read the form with positions using
-;;; edebug-read, then parse its structure.
-;;; * Parsing uses generalized "edebug-match-" functions for matching specs.
-;;; * Generalize handling of keyword specs (e.g. &something) to implicitly
-;;; bracket all following specs.
-;;; * Added new specs: arg, lambda-expr, place, gate, &key, and nil.
-;;; * Changed arglist to lambda-list.
-;;; * def-form macro does not assume arguments defined.
-;;; * Added support for dotted forms (with dotted spec lists and nil),
-;;; vectors, and the new backquote that supports nested backquotes.
-;;; * Added utilities edebug-unwrap and edebug-unwrap*
-;;; * Support emacs 19 "lambda" macros.
-;;; * Moved cl.el support to cl-specs.el. Many fixes, thanks to Dave Gillespie.
-;;; * Added specs for advice.el by Hans Chalupsky (hans@cs.buffalo.edu).
-;;; * Changed edebug-step-through-mode to edebug-step-mode.
-;;; * Make setting of the initial execution mode outside of edebug change
-;;; the mode once, rather than using edebug-initial-mode.
-;;; * Fix tracing so breakpoints stop.
-;;; * Check while edebugging whether source was changed.
-;;; * Fix edebug-step-in.
-;;; * Added: edebug-print-length, edebug-print-level, edebug-print-circle.
-;;; * Do all edebug evaluations safely (in condition-case) and
-;;; if custom-print is being used, print safely.
-;;; * Add bindings compatible with GUD standard.
-;;;
-
-;;; For the rest of the revision history, see edebug-history.
-
-(defconst edebug-version
- (let ((raw-version "$Revision: 3.4 $"))
- (substring raw-version (string-match "[0-9.]*" raw-version 11)
- (match-end 0))))
-
-(require 'backquote)
-
-;; Emacs 18 doesnt have defalias.
-(eval-and-compile
- (or (fboundp 'defalias) (fset 'defalias 'fset)))
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;; Commentary:
-;;;; Bug reporting
-;;; ==============
+;; This minor mode allows programmers to step through Emacs Lisp
+;; source code while executing functions. You can also set
+;; breakpoints, trace (stopping at each expression), evaluate
+;; expressions as if outside Edebug, reevaluate and display a list of
+;; expressions, trap errors normally caught by debug, and display a
+;; debug style backtrace.
-(defconst edebug-maintainer-address "liberte@cs.uiuc.edu")
+;;; Minimal Instructions
+;; =====================
-(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-stop-before-symbols
- '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
- ))))
-
-
-;;;; Options
-;;; ===============================
-
-(defvar edebug-setup-hook nil
+;; First evaluate a defun with C-M-x, then run the function. Step
+;; through the code with SPC, mark breakpoints with b, go until a
+;; breakpoint is reached with g, and quit execution with q. Use the
+;; "?" command in edebug to describe other commands.
+;; See the Emacs Lisp Reference Manual for more details.
+
+;; If you wish to change the default edebug global command prefix, change:
+;; (setq edebug-global-prefix "\C-xX")
+
+;; Edebug was written by
+;; Daniel LaLiberte
+;; GTE Labs
+;; 40 Sylvan Rd
+;; Waltham, MA 02254
+;; liberte@holonexus.org
+
+;;; Code:
+
+;;; Bug reporting
+
+(defalias 'edebug-submit-bug-report 'report-emacs-bug)
+
+;;; Options
+
+(defgroup edebug nil
+ "A source-level debugger for Emacs Lisp."
+ :group 'lisp)
+
+
+(defcustom edebug-setup-hook nil
"*Functions to call before edebug is used.
-Its value is reset to nil after being used, so each time it is set
-to a new function, that function will be called once and only once.")
+Each time it is set to a new value, Edebug will call those functions
+once and then `edebug-setup-hook' is reset to nil. You could use this
+to load up Edebug specifications associated with a package you are
+using but only when you also use Edebug."
+ :type 'hook
+ :group 'edebug)
-(defvar edebug-all-defs nil
- "*If non-nil, evaluation of any defining forms will use Edebug.
-`eval-defun' without prefix arg and `eval-region' will use
-`edebug-eval-top-level-form'.
+;; edebug-all-defs and edebug-all-forms need to be autoloaded
+;; because the byte compiler binds them; as a result, if edebug
+;; is first loaded for a require in a compilation, they will be left unbound.
-If nil, `eval-region' evaluates normally, but `eval-defun' with prefix arg
-uses `edebug-eval-top-level-form'. `eval-region' is called by `eval-defun',
+;;;###autoload
+(defcustom edebug-all-defs nil
+ "*If non-nil, evaluating defining forms instruments for Edebug.
+This applies to `eval-defun', `eval-region', `eval-buffer', and
+`eval-current-buffer'. `eval-region' is also called by
`eval-last-sexp', and `eval-print-last-sexp'.
You can use the command `edebug-all-defs' to toggle the value of this
-variable. You may wish to make this variable local to each
-buffer with (make-local-variable 'edebug-all-defs) in your
-`emacs-lisp-mode-hook'.")
+variable. You may wish to make it local to each buffer with
+\(make-local-variable 'edebug-all-defs) in your
+`emacs-lisp-mode-hook'."
+ :type 'boolean
+ :group 'edebug)
-(defvar edebug-all-forms nil
- "*Non-nil means edebug the evaluation of all forms.
-This doesn't apply to loading or evaluations in the minibuffer.
-Use the command edebug-all-forms to toggle the value of this option.")
+;; edebug-all-defs and edebug-all-forms need to be autoloaded
+;; because the byte compiler binds them; as a result, if edebug
+;; is first loaded for a require in a compilation, they will be left unbound.
-(defvar edebug-eval-macro-args nil
- "*Non-nil means all macro call arguments may be evaluated.
-If this variable is nil, the default, edebug will *not* wrap
-macro call arguments as if they will be evaluated.
-For each macro, a edebug-form-spec overrides this option.
+;;;###autoload
+(defcustom edebug-all-forms nil
+ "*Non-nil evaluation of all forms will instrument for Edebug.
+This doesn't apply to loading or evaluations in the minibuffer.
+Use the command `edebug-all-forms' to toggle the value of this option."
+ :type 'boolean
+ :group 'edebug)
+
+(defcustom edebug-eval-macro-args nil
+ "*Non-nil means all macro call arguments may be evaluated.
+If this variable is nil, the default, Edebug will *not* wrap
+macro call arguments as if they will be evaluated.
+For each macro, a `edebug-form-spec' overrides this option.
So to specify exceptions for macros that have some arguments evaluated
-and some not, you should specify an edebug-form-spec.
+and some not, you should specify an `edebug-form-spec'."
+ :type 'boolean
+ :group 'edebug)
-This option is going away soon.")
-
-(defvar edebug-stop-before-symbols nil
- "*Non-nil causes edebug to stop before symbols as well as after.
-In any case, it is possible to stop before a symbol with a breakpoint or
-interrupt.")
-
-(defvar edebug-save-windows t
- "*If non-nil, save and restore window configuration on edebug calls.
-It takes some time to save and restore, so if your program does not care
-what happens to the window configurations, it is better to set this
-variable to nil.
+(defcustom edebug-save-windows t
+ "*If non-nil, Edebug saves and restores the window configuration.
+That takes some time, so if your program does not care what happens to
+the window configurations, it is better to set this variable to nil.
If the value is a list, only the listed windows are saved and
-restored.
+restored.
-`edebug-toggle-save-windows' may be used to change this variable.")
+`edebug-toggle-save-windows' may be used to change this variable."
+ :type '(choice boolean (repeat string))
+ :group 'edebug)
-(defvar edebug-save-displayed-buffer-points nil
- "*If non-nil, save and restore the points of all displayed buffers.
+(defcustom edebug-save-displayed-buffer-points nil
+ "*If non-nil, save and restore point in all displayed buffers.
-Saving and restoring buffer points is necessary if you are debugging
-code that changes the point of a buffer which is displayed in a
-non-selected window. If edebug or the user then selects the
+Saving and restoring point in other buffers is necessary if you are
+debugging code that changes the point of a buffer which is displayed
+in a non-selected window. If Edebug or the user then selects the
window, the buffer's point will be changed to the window's point.
-But this is an expensive operation since it visits each
-window and therefore each displayed buffer twice for each edebug call,
-so it is best to avoid it if you can.")
-
-(defvar edebug-initial-mode 'step
- "*Initial execution mode for Edebug, if non-nil.
-This is used when edebug is first entered for each recursive-edit
-level. Possible values are nil (which means leave
-edebug-execution-mode as is), step, (the default), next, go,
-Go-nonstop, trace, Trace-fast, continue, and Continue-fast.")
-
-(defvar edebug-trace nil
- "*Non-nil if edebug should show a trace of function entry and exit.
-Tracing output is displayed in a buffer named by the variable
-edebug-trace-buffer, one function entry or exit per line, indented by
-the stack depth. You can customize by replacing functions
-edebug-print-trace-before and edebug-print-trace-after.")
-
-(defvar edebug-test-coverage nil
+Saving and restoring point in all buffers is expensive, since it
+requires selecting each window twice, so enable this only if you need
+it."
+ :type 'boolean
+ :group 'edebug)
+
+(defcustom edebug-initial-mode 'step
+ "*Initial execution mode for Edebug, if non-nil.
+If this variable is non-nil, it specifies the initial execution mode
+for Edebug when it is first activated. Possible values are step, next,
+go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast."
+ :type '(choice (const step) (const next) (const go)
+ (const Go-nonstop) (const trace)
+ (const Trace-fast) (const continue)
+ (const Continue-fast))
+ :group 'edebug)
+
+(defcustom edebug-trace nil
+ "*Non-nil means display a trace of function entry and exit.
+Tracing output is displayed in a buffer named `*edebug-trace*', one
+function entry or exit per line, indented by the recursion level.
+
+You can customize by replacing functions `edebug-print-trace-before'
+and `edebug-print-trace-after'."
+ :type 'boolean
+ :group 'edebug)
+
+(defcustom edebug-test-coverage nil
"*If non-nil, Edebug tests coverage of all expressions debugged.
This is done by comparing the result of each expression
with the previous result. Coverage is considered OK if two different
-results are found. So to sufficiently test the coverage of your code,
-try to execute it under conditions that evaluate all expressions more
-than once, and produce different results for each expression.
+results are found.
Use `edebug-display-freq-count' to display the frequency count and
-coverage information for a definition.")
-
-(defvar edebug-continue-kbd-macro nil
- "*If non-nil, continue executing any keyboard macro that is
-executing outside. Use this with caution since it is not debugged.")
-
-(defvar edebug-global-break-condition nil
- "*If non-nil, an expression to test for at every stop point.
-If the result is non-nil, then break. Errors are ignored.")
-
-
-(defvar edebug-print-length 50
- "*Default value of print-length to use while printing results in edebug.")
-(defvar edebug-print-level 50
- "*Default value of print-level to use while printing results in edebug.")
-(defvar edebug-print-circle t
- "*Default value of print-circle to use while printing results in edebug.")
-
-(defvar edebug-unwrap-results nil
+coverage information for a definition."
+ :type 'boolean
+ :group 'edebug)
+
+(defcustom edebug-continue-kbd-macro nil
+ "*If non-nil, continue defining or executing any keyboard macro.
+Use this with caution since it is not debugged."
+ :type 'boolean
+ :group 'edebug)
+
+
+(defcustom edebug-print-length 50
+ "*Default value of `print-length' for printing results in Edebug."
+ :type 'integer
+ :group 'edebug)
+(defcustom edebug-print-level 50
+ "*Default value of `print-level' for printing results in Edebug."
+ :type 'integer
+ :group 'edebug)
+(defcustom edebug-print-circle t
+ "*Default value of `print-circle' for printing results in Edebug."
+ :type 'boolean
+ :group 'edebug)
+
+(defcustom edebug-unwrap-results nil
"*Non-nil if Edebug should unwrap results of expressions.
This is useful when debugging macros where the results of expressions
are instrumented expressions. But don't do this when results might be
-circular or an infinite loop will result.")
+circular or an infinite loop will result."
+ :type 'boolean
+ :group 'edebug)
-(defvar edebug-on-error t
+(defcustom edebug-on-error t
"*Value bound to `debug-on-error' while Edebug is active.
If `debug-on-error' is non-nil, that value is still used.
these errors are signaled from Lisp code whether or not the signal is
handled by a `condition-case'. This option is useful for debugging
signals that *are* handled since they would otherwise be missed.
-After execution is resumed, the error is signaled again.")
+After execution is resumed, the error is signaled again."
+ :type '(choice (const :tag "off")
+ (repeat :menu-tag "When"
+ :value (nil)
+ (symbol :format "%v"))
+ (const :tag "always" t))
+ :group 'edebug)
+
+(defcustom edebug-on-quit t
+ "*Value bound to `debug-on-quit' while Edebug is active."
+ :type 'boolean
+ :group 'edebug)
+
+(defcustom edebug-global-break-condition nil
+ "*If non-nil, an expression to test for at every stop point.
+If the result is non-nil, then break. Errors are ignored."
+ :type 'sexp
+ :group 'edebug)
-(defvar edebug-on-quit t
- "*Value bound to `debug-on-quit' while Edebug is active.")
+(defcustom edebug-sit-for-seconds 1
+ "*Number of seconds to pause when execution mode is `trace'."
+ :type 'number
+ :group 'edebug)
-;;;; Form spec utilities.
-;;; ===============================
+;;; Form spec utilities.
;;;###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)))))
+\(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
))
+;;; Utilities
-;;;; Utilities
-;;; ===============================
-
-(if (not (fboundp 'gensym))
- (progn
+;; Define edebug-gensym - from old cl.el
+(defvar edebug-gensym-index 0
+ "Integer used by `edebug-gensym' to produce new names.")
-;; Define gensym - from old cl.el
-(defvar *gensym-index* 0
- "Integer used by gensym to produce new names.")
-
-(defun gensym (&optional prefix)
+(defun edebug-gensym (&optional prefix)
"Generate a fresh uninterned symbol.
There is an optional argument, PREFIX. PREFIX is the
string that begins the new name. Most people take just the default,
(let ((newsymbol nil)
(newname ""))
(while (not newsymbol)
- (setq newname (concat prefix *gensym-index*))
- (setq *gensym-index* (+ *gensym-index* 1))
+ (setq newname (concat prefix (int-to-string edebug-gensym-index)))
+ (setq edebug-gensym-index (+ edebug-gensym-index 1))
(if (not (intern-soft newname))
(setq newsymbol (make-symbol newname))))
newsymbol))
-))
-
-(if (not (fboundp 'keywordp))
- (defun 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 lambda-list-keywordp (object)
+(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 ""&""."
+A lambda list keyword is a symbol that starts with `&'."
(and (symbolp object)
(= ?& (aref (symbol-name object) 0))))
(defun edebug-last-sexp ()
;; Return the last sexp before point in current buffer.
- Assumes elisp syntax is active.
+ ;; Assumes Emacs Lisp syntax is active.
(car
(read-from-string
(buffer-substring
(point)))))
(defun edebug-window-list ()
- "Return a list of windows, in order of next-window."
- ;; This doesnt 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)))
+ "Return a list of windows, in order of `next-window'."
+ ;; This doesn't work for epoch.
+ (let (window-list)
+ (walk-windows (lambda (w) (push w window-list)))
(nreverse window-list)))
-(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)
- (and (listp object)
- (eq (car object) 'lambda)
- (listp (car (cdr object)))))
+ (functionp (cdr object)))
object))
(defun edebug-sort-alist (alist function)
and the restriction will be restored to the original buffer,
and the current buffer remains current.
Return the result of the last expression in BODY."
- (` (let ((edebug:s-r-beg (point-min-marker))
- (edebug:s-r-end (point-max-marker)))
- (unwind-protect
- (progn (,@ body))
- (save-excursion
- (set-buffer (marker-buffer edebug:s-r-beg))
- (narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
+ `(let ((edebug:s-r-beg (point-min-marker))
+ (edebug:s-r-end (point-max-marker)))
+ (unwind-protect
+ (progn ,@body)
+ (save-excursion
+ (set-buffer (marker-buffer edebug:s-r-beg))
+ (narrow-to-region edebug:s-r-beg edebug:s-r-end)))))
-;;;; Display
-;;; ============
+;;; Display
(defconst edebug-trace-buffer "*edebug-trace*"
"Name of the buffer to put trace info in.")
(defun edebug-pop-to-buffer (buffer &optional window)
;; Like pop-to-buffer, but select window where BUFFER was last shown.
- ;; Select WINDOW if it 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)
(split-window))
;; (message "next window: %s" (next-window)) (sit-for 1)
(if (eq (get-buffer-window edebug-trace-buffer) (next-window))
- ;; Dont select trace window
+ ;; Don't select trace window
nil
(select-window (next-window))))
(set-window-buffer (selected-window) buffer)
(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
(defalias 'edebug-input-pending-p 'input-pending-p)
-;;;; Redefine read and eval functions
-;;; =================================
-;;; read is redefined to maybe instrument forms.
-;;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
-
-;;; Use the Lisp version of eval-region.
-(require 'elisp-eval-region "eval-region")
+;;; Redefine read and eval functions
+;; read is redefined to maybe instrument forms.
+;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
;; Save the original read function
(or (fboundp 'edebug-original-read)
(defalias 'edebug-original-read (symbol-function 'read)))
-(defun edebug-read (stream)
- "Read a Lisp expression as text from STREAM, return as Lisp object.
-For this version, from Edebug, STREAM must be nil, which means use the
-current buffer. This version maybe instruments the expression after
-reading it, depending on the values of `edebug-all-defs' and
+(defun edebug-read (&optional stream)
+ "Read one Lisp expression as text from STREAM, return as Lisp object.
+If STREAM is nil, use the value of `standard-input' (which see).
+STREAM or the value of `standard-input' may be:
+ a buffer (read from point and advance it)
+ a marker (read from where it points and advance it)
+ a function (call it with no arguments for each character,
+ call it with a char as argument to push a char back)
+ a string (takes text from string, starting at the beginning)
+ t (read text line using minibuffer and use it).
+
+This version, from Edebug, maybe instruments the expression. But the
+STREAM must be the current buffer to do so. Whether it instruments is
+also dependent on the values of `edebug-all-defs' and
`edebug-all-forms'."
- (if (or (null stream) (eq stream (current-buffer)))
+ (or stream (setq stream standard-input))
+ (if (eq stream (current-buffer))
(edebug-read-and-maybe-wrap-form)
(edebug-original-read stream)))
-
-(defmacro with-edebug-read (&rest body)
- ;; Temporarily set the read routine to edebug-read.
- (` (unwind-protect
- (progn
- (fset 'read 'edebug-read)
- (,@ body))
- (fset 'read 'edebug-original-read))))
-
-
(or (fboundp 'edebug-original-eval-defun)
(defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
+;; We should somehow arrange to be able to do this
+;; without actually replacing the eval-defun command.
(defun edebug-eval-defun (edebug-it)
"Evaluate the top-level form containing point, or after point.
-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: <function name>\".
-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))
- (setq edebug-result
- (eval
- (let ((edebug-all-forms edebugging)
- (edebug-all-defs (and edebug-all-defs (not edebug-it))))
- (edebug-read-top-level-form))))
+ (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
+ (edebug-result)
+ (form
+ (let ((edebug-all-forms edebugging)
+ (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
+ (edebug-read-top-level-form))))
+ ;; This should be consistent with `eval-defun-1', but not the
+ ;; same, since that gets a macroexpanded form.
+ (cond ((and (eq (car form) 'defvar)
+ (cdr-safe (cdr-safe form)))
+ ;; Force variable to be bound.
+ (makunbound (nth 1 form)))
+ ((and (eq (car form) 'defcustom)
+ (default-boundp (nth 1 form)))
+ ;; Force variable to be bound.
+ (set-default (nth 1 form) (eval (nth 2 form))))
+ ((eq (car form) 'defface)
+ ;; Reset the face.
+ (setq face-new-frame-defaults
+ (assq-delete-all (nth 1 form) face-new-frame-defaults))
+ (put (nth 1 form) 'face-defface-spec nil)
+ ;; See comments in `eval-defun-1' for purpose of code below
+ (setq form (prog1 `(prog1 ,form
+ (put ',(nth 1 form) 'saved-face
+ ',(get (nth 1 form) 'saved-face))
+ (put ',(nth 1 form) 'customized-face
+ ,(nth 2 form)))
+ (put (nth 1 form) 'saved-face nil)))))
+ (setq edebug-result (eval form))
(if (not edebugging)
(princ edebug-result)
edebug-result)))
;;;###autoload
(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
- ;; Bind edebug-all-forms only while reading, not while evaling
+ (eval-expression
+ ;; Bind edebug-all-forms only while reading, not while evalling
;; but this causes problems while edebugging edebug.
- (let ((edebug-all-forms t))
+ (let ((edebug-all-forms t)
+ (edebug-all-defs t))
(edebug-read-top-level-form))))
"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")))
"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")))
-;; These two should always be used in pairs, or just install once and
-;; never uninstall.
(defun edebug-install-read-eval-functions ()
(interactive)
- (install-elisp-eval-region)
- (defalias 'read 'edebug-read)
- (defalias 'eval-defun 'edebug-eval-defun))
+ ;; Don't install if already installed.
+ (unless load-read-function
+ (setq load-read-function 'edebug-read)
+ (defalias 'eval-defun 'edebug-eval-defun)))
(defun edebug-uninstall-read-eval-functions ()
(interactive)
- (uninstall-elisp-eval-region)
- (defalias 'read 'edebug-original-read)
- (defalias 'eval-defun (symbol-function 'edebug-emacs-eval-defun)))
+ (setq load-read-function nil)
+ (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
-;;;; Edebug internal data
-;;; ===============================
+;;; Edebug internal data
-;;; The internal data that is needed for edebugging is kept in the
-;;; buffer-local variable `edebug-form-data'.
+;; The internal data that is needed for edebugging is kept in the
+;; buffer-local variable `edebug-form-data'.
(make-variable-buffer-local 'edebug-form-data)
-(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)
;; (set-marker (nth 2 entry) nil)
(setq edebug-form-data (delq entry edebug-form-data)))))
-
-;;;; Parser utilities
-;;; ===============================
-
+;;; Parser utilities
(defun edebug-syntax-error (&rest args)
;; Signal an invalid-read-syntax with ARGS.
(defconst edebug-read-syntax-table
;; Lookup table for significant characters indicating the class of the
;; token that follows. This is not a \"real\" syntax table.
- (let ((table (make-vector 256 'symbol))
+ (let ((table (make-char-table 'syntax-table 'symbol))
(i 0))
(while (< i ?!)
(aset table i 'space)
(aset table ?\( 'lparen)
(aset table ?\) 'rparen)
(aset table ?\' 'quote)
+ (aset table ?\` 'backquote)
+ (aset table ?\, 'comma)
(aset table ?\" 'string)
(aset table ?\? 'char)
(aset table ?\[ 'lbracket)
(aset table ?\. 'dot)
(aset table ?\# 'hash)
;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
- ;; We dont care about any other chars since they wont be seen.
+ ;; We don't care about any other chars since they won't be seen.
table))
(defun edebug-next-token-class ()
;; Move to the next token and return its class. We only care about
- ;; lparen, rparen, dot, quote, string, char, vector, or symbol.
+ ;; lparen, rparen, dot, quote, backquote, comma, string, char, vector,
+ ;; or symbol.
(edebug-skip-whitespace)
- (aref edebug-read-syntax-table (following-char)))
+ (if (and (eq (following-char) ?.)
+ (save-excursion
+ (forward-char 1)
+ (or (and (eq (aref edebug-read-syntax-table (following-char))
+ 'symbol)
+ (not (= (following-char) ?\;)))
+ (memq (following-char) '(?\, ?\.)))))
+ 'symbol
+ (aref edebug-read-syntax-table (following-char))))
(defun edebug-skip-whitespace ()
(cond
;; read goes one too far if a (possibly quoted) string or symbol
;; is immediately followed by non-whitespace.
- ((eq class 'symbol) (prog1
- (edebug-original-read (current-buffer))
- (if (not (eq (aref edebug-read-syntax-table
- (preceding-char)) 'symbol))
- (forward-char -1))))
- ((eq class 'string) (prog1
- (edebug-original-read (current-buffer))
- (if (/= (preceding-char) ?\")
- (forward-char -1))))
+ ((eq class 'symbol) (edebug-original-read (current-buffer)))
+ ((eq class 'string) (edebug-original-read (current-buffer)))
((eq class 'quote) (forward-char 1)
(list 'quote (edebug-read-sexp)))
+ ((eq class 'backquote)
+ (list '\` (edebug-read-sexp)))
+ ((eq class 'comma)
+ (list '\, (edebug-read-sexp)))
(t ; anything else, just read it.
(edebug-original-read (current-buffer))))))
-
-;;;; Offsets for reader
-;;; ==============================
+;;; Offsets for reader
;; Define a structure to represent offset positions of expressions.
;; Each offset structure looks like: (before . after) for constituents,
;; or for structures that have elements: (before <subexpressions> . after)
;; where the <subexpressions> are the offset structures for subexpressions
;; including the head of a list.
-(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)
- (` (unwind-protect
- (progn
- (edebug-store-before-offset (, point))
- (,@ body))
- (edebug-store-after-offset (point)))))
+ (declare (debug (form body)) (indent 1))
+ `(unwind-protect
+ (progn
+ (edebug-store-before-offset ,point)
+ ,@body)
+ (edebug-store-after-offset (point))))
+
+;;; Reader for Emacs Lisp.
-;;;; Reader for Emacs Lisp.
-;;; ==========================================
;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.
(defconst edebug-read-alist
(lparen . edebug-read-list)
(string . edebug-read-string)
(quote . edebug-read-quote)
+ (backquote . edebug-read-backquote)
+ (comma . edebug-read-comma)
(lbracket . edebug-read-vector)
(hash . edebug-read-function)
))
(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)
- (prog1
- (edebug-original-read stream)
- ;; loses for escaped chars
- (if (not (eq (aref edebug-read-syntax-table
- (preceding-char)) 'symbol))
- (forward-char -1))))
+ (edebug-original-read stream))
(defun edebug-read-string (stream)
- (prog1
- (edebug-original-read stream)
- (if (/= (preceding-char) ?\")
- (forward-char -1))))
+ (edebug-original-read stream))
(defun edebug-read-quote (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)
+ (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.
+ (let ((opoint (point)))
+ (forward-char 1)
+ (let ((symbol '\,))
+ (cond ((eq (following-char) ?\.)
+ (setq symbol '\,\.)
+ (forward-char 1))
+ ((eq (following-char) ?\@)
+ (setq symbol '\,@)
+ (forward-char 1)))
+ ;; Generate the same structure of offsets we would have
+ ;; if the resulting list appeared verbatim in the input text.
+ (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)))
- (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 \]
))
-
-
-;;;; Cursors for traversal of list and vector elements with offsets.
-;;;====================================================================
+;;; Cursors for traversal of list and vector elements with offsets.
(defvar edebug-dotted-spec nil)
(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)
(setq offset (cdr offset)))
offset))
-;;;; The Parser
-;;; ===============================
+;;; The Parser
-;;; The top level function for parsing forms is
-;;; edebug-read-and-maybe-wrap-form; it calls all the rest. It checks the
-;;; syntax a bit and leaves point at any error it finds, but otherwise
-;;; should appear to work like eval-defun.
+;; The top level function for parsing forms is
+;; edebug-read-and-maybe-wrap-form; it calls all the rest. It checks the
+;; syntax a bit and leaves point at any error it finds, but otherwise
+;; should appear to work like eval-defun.
-;;; The basic plan is to surround each expression with a call to
-;;; the edebug debugger together with indexes into a table of positions of
-;;; all expressions. Thus an expression "exp" becomes:
+;; The basic plan is to surround each expression with a call to
+;; the edebug debugger together with indexes into a table of positions of
+;; all expressions. Thus an expression "exp" becomes:
-;;; (edebug-after (edebug-before 1) 2 exp)
+;; (edebug-after (edebug-before 1) 2 exp)
-;;; When this is evaluated, first point is moved to the beginning of
-;;; exp at offset 1 of the current function. The expression is
-;;; evaluated, which may cause more edebug calls, and then point is
-;;; moved to offset 2 after the end of exp.
+;; When this is evaluated, first point is moved to the beginning of
+;; exp at offset 1 of the current function. The expression is
+;; evaluated, which may cause more edebug calls, and then point is
+;; moved to offset 2 after the end of exp.
-;;; The highest level expressions of the function are wrapped in a call to
-;;; edebug-enter, which supplies the function name and the actual
-;;; arguments to the function. See functions edebug-enter, edebug-before,
-;;; and edebug-after for more details.
+;; The highest level expressions of the function are wrapped in a call to
+;; edebug-enter, which supplies the function name and the actual
+;; arguments to the function. See functions edebug-enter, edebug-before,
+;; and edebug-after for more details.
;; Dynamically bound vars, left unbound, but globally declared.
;; This is to quiet the byte compiler.
(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 ()
;; Here we just catch any no-match not caught below and signal an error.
;; Run the setup hook.
- (run-hooks 'edebug-setup-hook)
- (setq edebug-setup-hook nil)
+ ;; If it gets an error, make it nil.
+ (let ((temp-hook edebug-setup-hook))
+ (setq edebug-setup-hook nil)
+ (run-hooks 'temp-hook))
(let (result
edebug-top-window-data
edebug-def-name;; make sure it is locally nil
- ;; I dont like these here!!
+ ;; I don't like these here!!
edebug-&optional
edebug-&rest
edebug-gate
no-match
;; Do this once here instead of several times.
(max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
- (max-specpdl-size (+ 1200 max-specpdl-size)))
+ (max-specpdl-size (+ 2000 max-specpdl-size)))
(setq no-match
(catch 'no-match
(setq result (edebug-read-and-maybe-wrap-form1))
def-kind
defining-form-p
def-name
- ;; These offset things dont belong here, but to support recursive
+ ;; These offset things don't belong here, but to support recursive
;; calls to edebug-read, they need to be here.
edebug-offsets
edebug-offsets-stack
(if (and (eq 'lparen (edebug-next-token-class))
(eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
;; Find out if this is a defining form from first symbol
- (setq def-kind (read (current-buffer))
+ (setq def-kind (edebug-original-read (current-buffer))
spec (and (symbolp def-kind) (get-edebug-spec def-kind))
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)))
- (read (current-buffer))))))
+ (edebug-original-read (current-buffer))))))
+;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(cond
(defining-form-p
(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.
(defun edebug-wrap-def-body (forms)
"Wrap the FORMS of a definition body."
(if edebug-def-interactive
- (` (let (((, (edebug-interactive-p-name))
- (interactive-p)))
- (, (edebug-make-enter-wrapper forms))))
+ `(let ((,(edebug-interactive-p-name)
+ (interactive-p)))
+ ,(edebug-make-enter-wrapper forms))
(edebug-make-enter-wrapper forms)))
;; 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
- (or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
- (` (edebug-enter
- (quote (, edebug-def-name))
- (, (if edebug-inside-func
- (` (list (,@
- ;; Doesnt work with more than one def-body!!
- ;; But the list will just be reversed.
- (nreverse edebug-def-args))))
- 'nil))
- (function (lambda () (,@ forms)))
- )))
+ (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
+ `(list
+ ;; Doesn't work with more than one def-body!!
+ ;; But the list will just be reversed.
+ ,@(nreverse edebug-def-args))
+ 'nil)
+ (function (lambda () ,@forms))
+ ))
(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.
- ;; if (not edebug-stop-before-symbols) and form is a symbol,
- ;; then dont call edebug-before.
- (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
- (or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
+ (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
((symbolp form)
(cond
- ;; Check for constant symbols that dont get wrapped.
+ ;; Check for constant symbols that don't get wrapped.
((or (memq form '(t nil))
(keywordp form))
form)
- ;; This option may go away.
- (edebug-stop-before-symbols
- (edebug-make-before-and-after-form
- (edebug-inc-offset (car offset))
- form
- (edebug-inc-offset (cdr offset))
- ))
-
(t ;; just a variable
(edebug-make-after-form form (edebug-inc-offset (cdr offset))))))
(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.
-;;; ===================
+;;; Matching of specs.
(defvar edebug-after-dotted-spec nil)
(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
;; with the two before- and after-offset functions.
(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
;; Define specs for all the symbol specs with functions used to process them.
-;; Perhaps we shouldnt be doing this with edebug-form-specs since the
+;; Perhaps we shouldn't be doing this with edebug-form-specs since the
;; 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)
- ;; (keywordp . edebug-match-keywordp)
- (¬ . 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
(let (edebug-gate ;; only while matching each spec
edebug-best-error
edebug-error-point)
- ;; Doesnt support e.g. &or symbolp &rest form
+ ;; Doesn't support e.g. &or symbolp &rest form
(edebug-match-one-spec cursor (car specs)))))
;; Match failed, so reset and try again.
(setq specs (cdr specs))
(edebug-no-match cursor "Unexpected"))
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-
+
(def-edebug-spec &key edebug-match-&key)
(defun edebug-match-&key (cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
- ;; This really doesnt save much over the expanded form and takes time.
- (edebug-match-&rest
+ ;; This really doesn't save much over the expanded form and takes time.
+ (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)
(defun edebug-match-&define (cursor specs)
;; Match a defining form.
- ;; Normally, &define is interpretted specially other places.
+ ;; Normally, &define is interpreted specially other places.
;; 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")
)))
-;; Not needed if the predicate exists.
-'(defun edebug-match-keywordp (cursor)
- ;; Match a common lisp style keyword symbol.
- (let ((sexp (edebug-top-element cursor)))
- (if (keywordp sexp)
- (prog1
- (list sexp)
- (edebug-move-cursor cursor))
- (edebug-no-match cursor "Keyword expected"))))
-
-
(defun edebug-match-name (cursor)
;; Set the edebug-def-name bound in edebug-defining-form.
(let ((name (edebug-top-element-required cursor "Expected name")))
;; set the def-args bound in edebug-defining-form
(let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
(if (or (not (symbolp edebug-arg))
- (lambda-list-keywordp edebug-arg))
+ (edebug-lambda-list-keywordp edebug-arg))
(edebug-no-match cursor "Bad argument:" edebug-arg))
(edebug-move-cursor cursor)
(setq edebug-def-args (cons edebug-arg edebug-def-args))
(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
("quote" symbolp)
edebug-spec-list
stringp
- [lambda-list-keywordp &rest edebug-spec]
+ [edebug-lambda-list-keywordp &rest edebug-spec]
[keywordp gate edebug-spec]
edebug-spec-p ;; Including all the special ones e.g. form.
symbolp;; a predicate
))
-;;;;* Emacs special forms and some functions.
+;;;* Emacs special forms and some functions.
;; quote expects only one argument, although it allows any number.
(def-edebug-spec quote sexp)
[&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) ;; denegrated - use lambda-list.
+(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
(def-edebug-spec lambda-list
(([&rest arg]
(def-edebug-spec condition-case
(symbolp
form
- &rest (symbolp body)))
+ &rest ([&or symbolp (&rest symbolp)] body)))
-(def-edebug-spec ` (backquote-form))
+(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])
;; ,@ might have some problems.
-(defalias 'edebug-` '`) ;; same macro as regular backquote.
-(def-edebug-spec edebug-` (def-form))
+(defalias 'edebug-\` '\`) ;; same macro as regular backquote.
+(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 eval-when-compile t)
(def-edebug-spec eval-and-compile t)
+(def-edebug-spec save-selected-window t)
+(def-edebug-spec save-current-buffer t)
+(def-edebug-spec delay-mode-hooks t)
+(def-edebug-spec with-temp-file 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?
-;;====================
;; Some miscellaneous specs for macros in public packages.
;; Send me yours.
;; 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)
-;;;; The debugger itself
-;;; ===============================
+(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
(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-;;; Handling signals
-;;; =================
+(defvar edebug-outside-overriding-local-map)
+(defvar edebug-outside-overriding-terminal-local-map)
-(if (not (fboundp 'edebug-emacs-signal))
- (defalias 'edebug-emacs-signal (symbol-function 'signal)))
-;; We should use advise for this!!
+(defvar edebug-outside-pre-command-hook)
+(defvar edebug-outside-post-command-hook)
+
+(defvar cl-lexical-debug) ;; Defined in cl.el
+
+;;; Handling signals
(defun edebug-signal (edebug-signal-name edebug-signal-data)
"Signal an error. Args are SIGNAL-NAME, and associated DATA.
(edebug 'error (cons edebug-signal-name edebug-signal-data)))
;; If we reach here without another non-local exit, then send signal again.
;; i.e. the signal is not continuable, yet.
- (edebug-emacs-signal edebug-signal-name edebug-signal-data))
-
+ ;; Avoid infinite recursion.
+ (let ((signal-hook-function nil))
+ (signal edebug-signal-name edebug-signal-data)))
;;; Entering Edebug
-;;; ==================
-
-(defvar cl-lexical-debug) ;; Defined in cl.el
(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,
- ;; but not after the unwind-protect.
- ;; Doing it here also keeps it from growing.
+ ;; 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??
(max-specpdl-size (+ 200 max-specpdl-size))
(debug-on-error (or debug-on-error edebug-on-error))
(debug-on-quit edebug-on-quit)
- ;; Save the outside value of executing macro. (here??)
- (edebug-outside-executing-macro executing-macro)
- ;; 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-macro (if edebug-continue-kbd-macro executing-macro))
-
;; Lexical bindings must be uncompiled for this to work.
- (cl-lexical-debug t))
- (setq edebug-execution-mode (or edebug-next-execution-mode
- edebug-initial-mode
- edebug-execution-mode)
- edebug-next-execution-mode nil)
- ;; Bind signal to edebug-signal only while Edebug is active.
- (fset 'signal 'edebug-signal)
+ (cl-lexical-debug t)
+
+ (edebug-outside-overriding-local-map overriding-local-map)
+ (edebug-outside-overriding-terminal-local-map
+ overriding-terminal-local-map)
+
+ ;; Save the outside value of executing macro. (here??)
+ (edebug-outside-executing-macro executing-kbd-macro)
+ (edebug-outside-pre-command-hook
+ (edebug-var-status 'pre-command-hook))
+ (edebug-outside-post-command-hook
+ (edebug-var-status 'post-command-hook)))
(unwind-protect
- (edebug-enter edebug-function edebug-args edebug-body)
- (fset 'signal (symbol-function 'edebug-emacs-signal))))
-
+ (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
+ (if edebug-continue-kbd-macro executing-kbd-macro))
+
+ ;; Don't get confused by the user's keymap changes.
+ (overriding-local-map nil)
+ (overriding-terminal-local-map nil)
+
+ (signal-hook-function 'edebug-signal)
+
+ ;; Disable command hooks. This is essential when
+ ;; a hook function is instrumented - to avoid infinite loop.
+ ;; 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
+ 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)
+ (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
(defmacro edebug-tracing (msg &rest body)
"Print MSG in *edebug-trace* before and after evaluating BODY.
The result of BODY is also printed."
- (` (let ((edebug-stack-depth (1+ edebug-stack-depth))
- edebug-result)
- (edebug-print-trace-before (, msg))
- (prog1 (setq edebug-result (progn (,@ body)))
- (edebug-print-trace-after
- (format "%s result: %s" (, msg) edebug-result))))))
+ `(let ((edebug-stack-depth (1+ edebug-stack-depth))
+ edebug-result)
+ (edebug-print-trace-before ,msg)
+ (prog1 (setq edebug-result (progn ,@body))
+ (edebug-print-trace-after
+ (format "%s result: %s" ,msg edebug-result)))))
(defun edebug-print-trace-before (msg)
"Function called to print trace info before expression evaluation.
(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-previous-result nil) ;; Last result returned.
-;; Emacs 18
-(defalias 'edebug-mark 'mark)
+;; Emacs 19 adds an arg to mark and mark-marker.
(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-trace-window
+ edebug-trace-window-start
+
(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))
+ (unwind-protect
+ (let ((overlay-arrow-position overlay-arrow-position)
+ (overlay-arrow-string overlay-arrow-string)
+ (cursor-in-echo-area nil)
+ ;; 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
+ (edebug-current-windows edebug-save-windows)))
+
+ (if edebug-save-displayed-buffer-points
+ (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
+
+ ;; First move the edebug buffer point to edebug-point
+ ;; so that window start doesn't get changed when we display it.
+ ;; I don't know if this is going to help.
+ ;;(set-buffer edebug-buffer)
+ ;;(goto-char edebug-point)
+
+ ;; If edebug-buffer is not currently displayed,
+ ;; first find a window for it.
+ (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))
+ (setcar edebug-window-data (selected-window))
+
+ ;; Now display eval list, if any.
+ ;; 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.
+ (select-window (car edebug-window-data))
+ (set-buffer edebug-buffer)
+
+ (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"
+ edebug-function)
+ )))
- overlay-arrow-position
- overlay-arrow-string
- (cursor-in-echo-area nil)
- ;; any others??
+ (setcdr edebug-window-data
+ (edebug-adjust-window (cdr edebug-window-data)))
- edebug-trace-window
- edebug-trace-window-start
- )
- (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
- (edebug-current-windows edebug-save-windows)))
-
- (if edebug-save-displayed-buffer-points
- (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
-
- ;; First move the edebug buffer point to edebug-point
- ;; so that window start doesnt get changed when we display it.
- ;; I dont know if this is going to help.
- ;;(set-buffer edebug-buffer)
- ;;(goto-char edebug-point)
-
- ;; If edebug-buffer is not currently displayed,
- ;; first find a window for it.
- (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))
- (setcar edebug-window-data (selected-window))
-
- ;; Now display eval list, if any.
- ;; 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.
- (select-window (car edebug-window-data))
- (set-buffer edebug-buffer)
-
- (setq edebug-buffer-outside-point (point))
- (goto-char edebug-point)
-
- (if (eq 'before edebug-arg-mode)
- ;; Check whether positions are uptodate - assumes never before symbol
- (if (not (memq (following-char) '(?\( ?\# ?\` )))
- (let ((debug-on-error nil))
- (error "Source has changed - reevaluate definition of %s"
- edebug-function)
- )))
+ ;; Test if there is input, not including keyboard macros.
+ (if (edebug-input-pending-p)
+ (progn
+ (setq edebug-execution-mode 'step
+ edebug-stop t)
+ (edebug-stop)
+ ;; (discard-input) ; is this unfriendly??
+ ))
+ ;; Now display arrow based on mode.
+ (edebug-overlay-arrow)
- (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)
- (progn
- (setq edebug-execution-mode 'step
- edebug-stop t)
- (edebug-stop)
- ;; (discard-input) ; is this unfriendly??
- ))
- ;; Now display arrow based on mode.
- (edebug-overlay-arrow)
-
- (cond
- ((eq 'error edebug-arg-mode)
- ;; Display error message
- (setq edebug-execution-mode 'step)
- (edebug-overlay-arrow)
- (beep)
- (if (eq 'quit (car edebug-value))
- (message "Quit")
- (edebug-report-error edebug-value)))
- (edebug-break
- (cond
- (edebug-global-break
- (message "Global Break: %s => %s"
- edebug-global-break-condition
- edebug-global-break-result))
- (edebug-break-condition
- (message "Break: %s => %s"
- edebug-break-condition
- edebug-break-result))
- ((not (eq edebug-execution-mode 'Continue-fast))
- (message "Break"))
- (t)))
-
- (t (message "")))
-
- (if (eq 'after edebug-arg-mode)
- (progn
- ;; Display result of previous evaluation.
- (if (and edebug-break
- (not (eq edebug-execution-mode 'Continue-fast)))
- (sit-for 1)) ; Show break message.
- (edebug-previous-result)))
-
- (cond
- (edebug-break
- (cond
- ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
- ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
- (t (setq edebug-stop t))))
- ;; not edebug-break
- ((eq edebug-execution-mode 'trace)
- (edebug-sit-for 1)) ; Force update and pause.
- ((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))
- (progn
- ;; (setq edebug-execution-mode 'step)
- ;; (edebug-overlay-arrow) ; this doesnt always show up.
- (edebug-recursive-edit))) ; <---------- Recursive edit
-
- ;; Reset the edebug-window-data to whatever it is now.
- (let ((window (if (eq (window-buffer) edebug-buffer)
- (selected-window)
- (edebug-get-buffer-window edebug-buffer))))
- ;; Remember window-start for edebug-buffer, if still displayed.
- (if window
- (progn
- (setcar edebug-window-data window)
- (setcdr edebug-window-data (window-start window)))))
-
- ;; Save trace window point before restoring outside windows.
- ;; Could generalize this for other buffers.
- (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
- (if edebug-trace-window
- (setq edebug-trace-window-start
- (and edebug-trace-window (window-start edebug-trace-window))))
-
- ;; Restore windows before continuing.
- (if edebug-save-windows
- (progn
- (edebug-set-windows edebug-outside-windows)
+ (cond
+ ((eq 'error edebug-arg-mode)
+ ;; Display error message
+ (setq edebug-execution-mode 'step)
+ (edebug-overlay-arrow)
+ (beep)
+ (if (eq 'quit (car edebug-value))
+ (message "Quit")
+ (edebug-report-error edebug-value)))
+ (edebug-break
+ (cond
+ (edebug-global-break
+ (message "Global Break: %s => %s"
+ edebug-global-break-condition
+ edebug-global-break-result))
+ (edebug-break-condition
+ (message "Break: %s => %s"
+ edebug-break-condition
+ edebug-break-result))
+ ((not (eq edebug-execution-mode 'Continue-fast))
+ (message "Break"))
+ (t)))
+
+ (t (message "")))
+
+ (if (eq 'after edebug-arg-mode)
+ (progn
+ ;; Display result of previous evaluation.
+ (if (and edebug-break
+ (not (eq edebug-execution-mode 'Continue-fast)))
+ (sit-for 1)) ; Show break message.
+ (edebug-previous-result)))
- ;; Restore displayed buffer points.
- ;; Needed even if restoring windows because
- ;; window-points are not restored. (correct?? should they be??)
- (if edebug-save-displayed-buffer-points
- (edebug-set-buffer-points edebug-buffer-points))
+ (cond
+ (edebug-break
+ (cond
+ ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
+ ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
+ (t (setq edebug-stop t))))
+ ;; not edebug-break
+ ((eq edebug-execution-mode 'trace)
+ (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause.
+ ((eq edebug-execution-mode 'Trace-fast)
+ (edebug-sit-for 0)) ; Force update and continue.
+ )
- ;; Unrestore trace window's window-point.
- (if edebug-trace-window
- (set-window-start edebug-trace-window
- edebug-trace-window-start))
-
- ;; Unrestore edebug-buffer's window-start, if displayed.
-;; (edebug-trace "selected-window: %s window-buffer: %s"
-;; (selected-window) (window-buffer))
-;; (edebug-trace "window-data: %s" edebug-window-data)
- (let ((window (car edebug-window-data)))
- (if (and window (edebug-window-live-p window)
- (eq (window-buffer) edebug-buffer))
+ (unwind-protect
+ (if (or edebug-stop
+ (memq edebug-execution-mode '(step next))
+ (eq edebug-arg-mode 'error))
(progn
- ;;(setcar edebug-window-data window)
- ;; (edebug-trace "unrestore window start: %s and point"
- ;; (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
- ;; because otherwise quitting doesnt leave point as is.
- ;; But this causes point to not be restored other times.
- ;; Also, it may not be a visible window.
- ;; (set-window-point window edebug-point)
- )))
-;; (edebug-trace "selected-window: %s window-buffer: %s"
-;; (selected-window) (window-buffer))
-;; (edebug-trace "window-data: %s" edebug-window-data)
-
- ;; Unrestore edebug-buffer's point. Rerestored below.
- ;; (goto-char edebug-point) ;; in edebug-buffer
- ;; (edebug-trace "unrestore edebug-buffer point: %s" (point))
- ;; (sit-for 1)
- )
- ;; Since we may be in a save-excursion, in case of quit,
- ;; reselect the outside window only.
- ;; Only needed if we are not recovering windows??
- (if (edebug-window-live-p edebug-outside-window)
- (select-window edebug-outside-window))
- ) ; if edebug-save-windows
-
- ;; Restore current buffer always, in case application needs it.
- (set-buffer edebug-outside-buffer)
- ;; Restore point, and mark.
- ;; Needed even if restoring windows because
- ;; that doesnt restore point and mark in the current buffer.
- ;; But dont restore point if edebug-buffer is same as current buffer.
- (if (not (eq edebug-buffer edebug-outside-buffer))
- (goto-char edebug-outside-point))
- (if (marker-buffer (edebug-mark-marker))
- ;; Does zmacs-regions need to be nil while doing set-marker?
- (set-marker (edebug-mark-marker) edebug-outside-mark))
- ;; (edebug-trace "done restoring and unrestoring") (sit-for 1)
- ) ; unwind-protect
- ;; 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-buffer-outside-point)
- (let ((current-buffer (current-buffer)))
- (set-buffer edebug-buffer)
- (goto-char edebug-buffer-outside-point)
- (set-buffer current-buffer))
- ;; ... nothing more.
- ))
+ ;; (setq edebug-execution-mode 'step)
+ ;; (edebug-overlay-arrow) ; This doesn't always show up.
+ (edebug-recursive-edit))) ; <---------- Recursive edit
+
+ ;; Reset the edebug-window-data to whatever it is now.
+ (let ((window (if (eq (window-buffer) edebug-buffer)
+ (selected-window)
+ (edebug-get-buffer-window edebug-buffer))))
+ ;; Remember window-start for edebug-buffer, if still displayed.
+ (if window
+ (progn
+ (setcar edebug-window-data window)
+ (setcdr edebug-window-data (window-start window)))))
+
+ ;; Save trace window point before restoring outside windows.
+ ;; Could generalize this for other buffers.
+ (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
+ (if edebug-trace-window
+ (setq edebug-trace-window-start
+ (and edebug-trace-window
+ (window-start edebug-trace-window))))
+
+ ;; Restore windows before continuing.
+ (if edebug-save-windows
+ (progn
+ (edebug-set-windows edebug-outside-windows)
+
+ ;; Restore displayed buffer points.
+ ;; Needed even if restoring windows because
+ ;; window-points are not restored. (should they be??)
+ (if edebug-save-displayed-buffer-points
+ (edebug-set-buffer-points edebug-buffer-points))
+
+ ;; Unrestore trace window's window-point.
+ (if 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)
+ (eq (window-buffer) edebug-buffer))
+ (progn
+ (set-window-start window (cdr edebug-window-data)
+ 'no-force)
+ ;; Unrestore edebug-buffer's window-point.
+ ;; Needed in addition to setting the buffer point
+ ;; - otherwise quitting doesn't leave point as is.
+ ;; But this causes point to not be restored at times.
+ ;; Also, it may not be a visible window.
+ ;; (set-window-point window edebug-point)
+ )))
+
+ ;; Unrestore edebug-buffer's point. Rerestored below.
+ ;; (goto-char edebug-point) ;; in edebug-buffer
+ )
+ ;; Since we may be in a save-excursion, in case of quit,
+ ;; reselect the outside window only.
+ ;; Only needed if we are not recovering windows??
+ (if (edebug-window-live-p edebug-outside-window)
+ (select-window edebug-outside-window))
+ ) ; if edebug-save-windows
+
+ ;; Restore current buffer always, in case application needs it.
+ (set-buffer edebug-outside-buffer)
+ ;; Restore point, and mark.
+ ;; Needed even if restoring windows because
+ ;; that doesn't restore point and mark in the current buffer.
+ ;; But don't restore point if edebug-buffer is current buffer.
+ (if (not (eq edebug-buffer edebug-outside-buffer))
+ (goto-char edebug-outside-point))
+ (if (marker-buffer (edebug-mark-marker))
+ ;; Does zmacs-regions need to be nil while doing set-marker?
+ (set-marker (edebug-mark-marker) edebug-outside-mark))
+ ) ; unwind-protect
+ ;; 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-buffer-outside-point)
+ (let ((current-buffer (current-buffer)))
+ (set-buffer edebug-buffer)
+ (goto-char edebug-buffer-outside-point)
+ (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)
+ )))
+
(defvar edebug-number-of-recursions 0)
;; Number of recursive edits started by edebug.
;; 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)
(defvar edebug-outside-standard-output)
(defvar edebug-outside-standard-input)
+(defvar edebug-outside-current-prefix-arg)
(defvar edebug-outside-last-command-char)
(defvar edebug-outside-last-command)
(defvar edebug-outside-this-command)
(defvar edebug-outside-last-input-char)
+;; Note: here we have defvars for variables that are
+;; built-in in certain versions.
+;; Each defvar makes a difference
+;; in versions where the variable is *not* built-in.
+
;; Emacs 18
(defvar edebug-outside-unread-command-char)
-(defvar unread-command-char -1) ;; Define for lemacs 19.9
-
-;; 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-last-nonmenu-event)
(defvar edebug-outside-track-mouse)
-;; For Emacs 18, define vars defined by Emacs 19.
-(defvar last-input-event nil)
-(defvar last-command-event nil)
-(defvar unread-command-events nil)
-(defvar last-event-frame nil)
-(defvar last-nonmenu-event nil)
-(defvar track-mouse nil)
-
;; Disable byte compiler warnings about unread-command-char and -event
;; (maybe works with byte-compile-version 2.22 at least)
(defvar edebug-unread-command-char-warning)
(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-inside-windows
(edebug-outside-map (current-local-map))
+
(edebug-outside-standard-output standard-output)
(edebug-outside-standard-input standard-input)
+ (edebug-outside-defining-kbd-macro defining-kbd-macro)
(edebug-outside-last-command-char last-command-char)
(edebug-outside-last-command last-command)
(edebug-outside-last-input-char last-input-char)
(edebug-outside-unread-command-char unread-command-char)
+ (edebug-outside-current-prefix-arg current-prefix-arg)
(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)
(edebug-outside-track-mouse track-mouse)
-
- ;; Declare the following local variables to protect global values.
- ;; Make it local, but use global value.
- ;; We could set these to the values for previous edebug call.
- (last-command-char last-command-char)
- (last-command last-command)
- (this-command this-command)
- (last-input-char last-input-char)
-
- ;; Assume no edebug command sets unread-command-char.
- (unread-command-char -1)
-
- ;; 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)
- (track-mouse nil)
-
- ;; Bind again to outside values.
- (debug-on-error edebug-outside-debug-on-error)
- (debug-on-quit edebug-outside-debug-on-quit)
-
- ;; Save the outside value of defining macro.
- (edebug-outside-defining-kbd-macro defining-kbd-macro)
- ;; Don't keep defining a 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"))
-
- (setq buffer-read-only t)
- (fset 'signal (symbol-function 'edebug-emacs-signal))
-
- (edebug-mode)
(unwind-protect
- (recursive-edit) ; <<<<<<<<<< Recursive edit
-
- ;; Do the following, even if quit occurs.
- (fset 'signal 'edebug-signal)
- (if edebug-backtrace-buffer
- (kill-buffer edebug-backtrace-buffer))
- ;; Could be an option to keep eval display up.
- (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
-
- ;; Remember selected-window after recursive-edit.
-;; (setq edebug-inside-window (selected-window))
-
- (store-match-data edebug-outside-match-data)
-
- ;; Recursive edit may have changed buffers,
- ;; so set it back before exiting let.
- (if (buffer-name edebug-buffer) ; if it still exists
- (progn
- (set-buffer edebug-buffer)
- (if (memq edebug-execution-mode '(go Go-nonstop))
- (edebug-overlay-arrow))
- (setq buffer-read-only edebug-buffer-read-only)
- (use-local-map edebug-outside-map)
- )
- ;; gotta have some other buffer to get its buffer local variables set
- (get-buffer-create " bogus edebug buffer"))
- )))
+ (let (
+ ;; 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)
+ (this-command this-command)
+ (last-input-char last-input-char)
+
+ ;; Assume no edebug command sets unread-command-char.
+ (unread-command-char -1)
+ (current-prefix-arg nil)
+
+ ;; More for Emacs 19
+ (last-input-event nil)
+ (last-command-event nil)
+ (unread-command-events nil)
+ (last-event-frame nil)
+ (last-nonmenu-event nil)
+ (track-mouse nil)
+
+ ;; Bind again to outside values.
+ (debug-on-error edebug-outside-debug-on-error)
+ (debug-on-quit edebug-outside-debug-on-quit)
+
+ ;; Don't keep defining a kbd macro.
+ (defining-kbd-macro
+ (if edebug-continue-kbd-macro defining-kbd-macro))
+
+ ;; others??
+ )
+
+ (if (and (eq edebug-execution-mode 'go)
+ (not (memq edebug-arg-mode '(after error))))
+ (message "Break"))
+
+ (setq buffer-read-only t)
+ (setq signal-hook-function nil)
+
+ (edebug-mode)
+ (unwind-protect
+ (recursive-edit) ; <<<<<<<<<< Recursive edit
+
+ ;; Do the following, even if quit occurs.
+ (setq signal-hook-function 'edebug-signal)
+ (if edebug-backtrace-buffer
+ (kill-buffer edebug-backtrace-buffer))
+ ;; Could be an option to keep eval display up.
+ (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
+
+ ;; Remember selected-window after recursive-edit.
+ ;; (setq edebug-inside-window (selected-window))
+
+ (set-match-data edebug-outside-match-data)
+
+ ;; Recursive edit may have changed buffers,
+ ;; so set it back before exiting let.
+ (if (buffer-name edebug-buffer) ; if it still exists
+ (progn
+ (set-buffer edebug-buffer)
+ (if (memq edebug-execution-mode '(go Go-nonstop))
+ (edebug-overlay-arrow))
+ (setq buffer-read-only edebug-buffer-read-only)
+ (use-local-map edebug-outside-map)
+ )
+ ;; gotta have a buffer to let its buffer local variables be set
+ (get-buffer-create " bogus edebug buffer"))
+ ));; inner let
+
+ ;; Reset global vars to outside values, in case they have been changed.
+ (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-events edebug-outside-unread-command-events
+ current-prefix-arg edebug-outside-current-prefix-arg
+ last-input-char edebug-outside-last-input-char
+ last-input-event edebug-outside-last-input-event
+ last-event-frame edebug-outside-last-event-frame
+ last-nonmenu-event edebug-outside-last-nonmenu-event
+ track-mouse edebug-outside-track-mouse
+
+ standard-output edebug-outside-standard-output
+ standard-input edebug-outside-standard-input
+ defining-kbd-macro edebug-outside-defining-kbd-macro
+ ))
+ ))
;;; Display related functions
-;;; ===============================
(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)
- (setq pos (point)))
+ (let ((pos (save-excursion (beginning-of-line) (point))))
(setq overlay-arrow-string
(cdr (assq edebug-execution-mode edebug-arrow-alist)))
(setq overlay-arrow-position (make-marker))
(if edebug-save-windows "on" "off")))
(defmacro edebug-changing-windows (&rest body)
- (` (let ((window (selected-window)))
- (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
- edebug-save-windows))
- ;; Problem: what about outside windows that are deleted inside?
- (edebug-set-windows edebug-inside-windows))))
+ `(let ((window (selected-window)))
+ (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
+ 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
(message "Displaying %s %s" buffer
(if already-displaying "off" "on"))))
-
;;; Breakpoint related functions
-;;; ===============================
(defun edebug-find-stop-point ()
;; Return (function . index) of the nearest 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)))
(car edebug-breakpoints)))
(goto-char (+ edebug-def-mark
(aref offset-vector (car breakpoint))))
-
- (message (concat (if (nth 2 breakpoint)
+
+ (message "%s"
+ (concat (if (nth 2 breakpoint)
"Temporary " "")
(if (car (cdr breakpoint))
(format "Condition: %s"
(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))
;;; Mode switching functions
-;;; ===============================
(defun edebug-set-mode (mode shortmsg msg)
;; Set the edebug mode to MODE.
(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."
(if (looking-at "\(")
(edebug-form-data-name
(edebug-get-form-data-entry (point)))
- (read (current-buffer))))))
+ (edebug-original-read (current-buffer))))))
(edebug-instrument-function func))))
(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-emacs-debug-on-entry))
- (fset 'edebug-emacs-debug-on-entry (symbol-function 'debug-on-entry)))
+
+(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?
;; Also need edebug-cancel-debug-on-entry
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))
- (edebug-emacs-debug-on-entry function)
+ (edebug-original-debug-on-entry function)
(edebug-on-entry function))))
;; (edebug-set-mode 'exiting "Exit..."))
-;;; -----------------------------------------------------------------
;;; The following initial mode setting definitions are not used yet.
'(defconst edebug-initial-mode-alist
(error "Key must map to one of the mode changing commands")
)))
-
;;; Evaluation of expressions
-;;; ===============================
(def-edebug-spec edebug-outside-excursion t)
(defmacro edebug-outside-excursion (&rest body)
"Evaluate an expression list in the outside context.
Return the result of the last expression."
- (` (save-excursion ; of current-buffer
- (if edebug-save-windows
- (progn
- ;; After excursion, we will
- ;; restore to current window configuration.
- (setq edebug-inside-windows
- (edebug-current-windows edebug-save-windows))
- ;; Restore outside windows.
- (edebug-set-windows edebug-outside-windows)))
-
- (set-buffer edebug-buffer) ; why?
- ;; (use-local-map edebug-outside-map)
- (store-match-data edebug-outside-match-data)
- ;; Restore outside context.
- (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
- (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)
- (last-input-char edebug-outside-last-input-char)
- (last-input-event edebug-outside-last-input-event)
- (last-event-frame edebug-outside-last-event-frame)
- (last-nonmenu-event edebug-outside-last-nonmenu-event)
- (track-mouse edebug-outside-track-mouse)
-
- (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)
- (standard-output edebug-outside-standard-output)
- (standard-input edebug-outside-standard-input)
- (executing-macro edebug-outside-executing-macro)
- (defining-kbd-macro edebug-outside-defining-kbd-macro)
- )
- (unwind-protect
- (save-excursion ; of edebug-buffer
- (set-buffer edebug-outside-buffer)
- (goto-char edebug-outside-point)
- (if (marker-buffer (edebug-mark-marker))
- (set-marker (edebug-mark-marker) edebug-outside-mark))
- (,@ body))
+ `(save-excursion ; of current-buffer
+ (if edebug-save-windows
+ (progn
+ ;; After excursion, we will
+ ;; restore to current window configuration.
+ (setq edebug-inside-windows
+ (edebug-current-windows edebug-save-windows))
+ ;; Restore outside windows.
+ (edebug-set-windows edebug-outside-windows)))
+
+ (set-buffer edebug-buffer) ; why?
+ ;; (use-local-map edebug-outside-map)
+ (set-match-data edebug-outside-match-data)
+ ;; Restore outside context.
+ (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
+ (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-events edebug-outside-unread-command-events)
+ (current-prefix-arg edebug-outside-current-prefix-arg)
+ (last-input-char edebug-outside-last-input-char)
+ (last-input-event edebug-outside-last-input-event)
+ (last-event-frame edebug-outside-last-event-frame)
+ (last-nonmenu-event edebug-outside-last-nonmenu-event)
+ (track-mouse edebug-outside-track-mouse)
+ (standard-output edebug-outside-standard-output)
+ (standard-input edebug-outside-standard-input)
+
+ (executing-kbd-macro edebug-outside-executing-macro)
+ (defining-kbd-macro edebug-outside-defining-kbd-macro)
+ ;; 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)
+ )
+ (unwind-protect
+ (save-excursion ; of edebug-buffer
+ (set-buffer edebug-outside-buffer)
+ (goto-char edebug-outside-point)
+ (if (marker-buffer (edebug-mark-marker))
+ (set-marker (edebug-mark-marker) edebug-outside-mark))
+ ,@body)
+
+ ;; Back to edebug-buffer. Restore rest of inside context.
+ ;; (use-local-map edebug-inside-map)
+ (if edebug-save-windows
+ ;; Restore inside windows.
+ (edebug-set-windows edebug-inside-windows))
+
+ ;; Save values that may have been changed.
+ (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-events unread-command-events
+ edebug-outside-current-prefix-arg current-prefix-arg
+ edebug-outside-last-input-char last-input-char
+ edebug-outside-last-input-event last-input-event
+ edebug-outside-last-event-frame last-event-frame
+ edebug-outside-last-nonmenu-event last-nonmenu-event
+ edebug-outside-track-mouse track-mouse
+ edebug-outside-standard-output standard-output
+ edebug-outside-standard-input standard-input
+
+ edebug-outside-executing-macro executing-kbd-macro
+ edebug-outside-defining-kbd-macro defining-kbd-macro
+
+ 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
+ )
- ;; Back to edebug-buffer. Restore rest of inside context.
- ;; (use-local-map edebug-inside-map)
- (if edebug-save-windows
- ;; Restore inside windows.
- (edebug-set-windows edebug-inside-windows))
- )) ; let
- )))
+ ;; 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))))))
-;;;; Printing
-;;; =========
+;;; Printing
+
;; 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
-;; edebug-save-prin1-to-string to only use these if defined.
+;; 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)
(let ((print-escape-newlines t)
(edebug-prin1-to-string value)))
(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 (numberp 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."
(interactive)
(message "%s" edebug-previous-result))
-;;;; Read, Eval and Print
-;;; =====================
+;;; 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*.
"
(use-local-map edebug-mode-map))
+;;; edebug eval list mode
-;;;; edebug eval list mode
-;;; ===============================================
;; A list of expressions and their evaluations is displayed in *edebug*.
(defun edebug-eval-result-list ()
"Return a list of evaluations of edebug-eval-list"
;; Assumes in outside environment.
- (mapcar 'edebug-safe-eval edebug-eval-list))
+ ;; Don't do any edebug things now.
+ (let ((edebug-execution-mode 'Go-nonstop)
+ (edebug-trace nil))
+ (mapcar 'edebug-safe-eval edebug-eval-list)))
(defun edebug-eval-display-list (edebug-eval-result-list)
;; Assumes edebug-eval-buffer exists.
(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.")
+ "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
+
+(unless edebug-eval-mode-map
+ (setq edebug-eval-mode-map (make-sparse-keymap))
+ (set-keymap-parent edebug-eval-mode-map lisp-interaction-mode-map)
-(if edebug-eval-mode-map
- nil
- (setq edebug-eval-mode-map (copy-keymap 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
\\{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-edebug-map}")
-;;;; Interface with standard debugger.
-;;; ========================================
+;;; Interface with standard debugger.
;; (setq debugger 'edebug) ; to use the edebug debugger
;; (setq debugger 'debug) ; use the 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))
)))))
\f
-;;;; Trace display
-;; ===============================
+;;; Trace display
(defun edebug-trace-display (buf-name fmt &rest args)
"In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
;; (edebug-trace-display "*trace-point*"
;; "saving: point = %s window-start = %s"
;; (point) (window-start))
- (let* ((selected-window (selected-window))
+ (let* ((oldbuf (current-buffer))
+ (selected-window (selected-window))
(buffer (get-buffer-create buf-name))
buf-window)
;; (message "before pop-to-buffer") (sit-for 1)
;; (set-window-point buf-window (point))
;; (edebug-sit-for 0)
(bury-buffer buffer)
- (select-window selected-window))
+ (select-window selected-window)
+ (set-buffer oldbuf))
buf-name)
(apply 'edebug-trace-display edebug-trace-buffer fmt args))
\f
-;;;; Frequency count and coverage
-;;; ==============================
+;;; 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))
(undo)))
\f
-;;;; Menus
-;;;=========
+;;; Menus
(defun edebug-toggle (variable)
(set variable (not (eval variable)))
(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.
-
-;; 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-emacs19-specific ()
+;;; Emacs version specific code
- (defalias 'edebug-window-live-p 'window-live-p)
+(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-mark ()
+ (mark t))
- ;; Use minibuffer-history when reading expressions.
- (defvar read-expression-history) ;; hush bytecomp
- (defvar read-expression-map)
-
- (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 edebug-mode-map "Edebug menus" edebug-mode-menus)
- )
-
-
-(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
- ;; Test Lucid first.
- ((string-match "Lucid" emacs-version);; lemacs
- (edebug-lemacs-specific))
-
- ((string-match "^19" emacs-version);; Emacs 19
- (edebug-emacs19-specific))
-
- ((and (boundp 'epoch::version) epoch::version)
- (require 'edebug-epoch))))
-
-(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
-;;; ====================
+;;; Byte-compiler
+
;; Extension for bytecomp to resolve undefined function references.
;; Requires new 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
- gensym keywordp;; cl.el
+ (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
- edebug-emacs-signal
;; lemacs
zmacs-deactivate-region
popup-menu
;; CL
cl-macroexpand-all
- ;; And believe it or not, the byte compiler doesnt know about:
+ ;; And believe it or not, the byte compiler doesn't know about:
byte-compile-resolve-functions
))
)))
\f
-;;;; Autoloading of Edebug accessories
-;;;===================================
+;;; Autoloading of Edebug accessories
(if (featurep 'cl)
(add-hook 'edebug-setup-hook
(add-hook 'cl-load-hook
(function (lambda () (require 'cl-specs)))))
+;;; 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))))
(function (lambda () (require 'edebug-cl-read)))))
\f
-;;;; Finalize Loading
-;;;===================
+;;; Finalize Loading
;;; Finally, hook edebug into the rest of Emacs.
;;; There are probably some other things that could go here.
(provide 'edebug)
+;;; arch-tag: 19c8d05c-4554-426e-ac72-e0fa1fcb0808
;;; edebug.el ends here
-