1996-03-20 13:30:16 +00:00
|
|
|
|
;;; edebug.el --- a source-level debugger for Emacs Lisp
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94,'95 Free Software Foundation, Inc
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1992-07-22 04:22:42 +00:00
|
|
|
|
;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
|
1993-03-18 21:29:42 +00:00
|
|
|
|
;; Keywords: lisp, tools, maint
|
1992-07-22 04:22:42 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; LCD Archive Entry:
|
|
|
|
|
;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
|
|
|
|
|
;; |A source level debugger for Emacs Lisp.
|
1996-10-02 21:41:56 +00:00
|
|
|
|
;; |$Date: 1996/09/24 06:54:18 $|$Revision: 3.10 $|~/modes/edebug.el|
|
1993-03-22 03:27:18 +00:00
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
|
|
;; any later version.
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
|
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
|
|
|
|
|
|
;;; 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
|
|
|
|
|
|
|
|
|
|
;; For the early revision history, see edebug-history.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defconst edebug-version
|
1996-10-02 21:41:56 +00:00
|
|
|
|
(let ((raw-version "$Revision: 3.10 $"))
|
1994-04-07 17:16:44 +00:00
|
|
|
|
(substring raw-version (string-match "[0-9.]*" raw-version)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(match-end 0))))
|
|
|
|
|
|
|
|
|
|
(require 'backquote)
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Emacs 18 doesn't have defalias.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(eval-and-compile
|
|
|
|
|
(or (fboundp 'defalias) (fset 'defalias 'fset)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Bug reporting
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defconst edebug-maintainer-address "liberte@cs.uiuc.edu")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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
|
|
|
|
|
))))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Options
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-setup-hook nil
|
|
|
|
|
"*Functions to call before edebug is used.
|
1994-04-08 21:39:52 +00:00
|
|
|
|
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.")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-all-defs nil
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*If non-nil, evaluation of any defining forms will instrument for Edebug.
|
|
|
|
|
This applies to `eval-defun', `eval-region', `eval-buffer', and
|
|
|
|
|
`eval-current-buffer'. `eval-region' is also called by
|
1994-03-24 20:38:34 +00:00
|
|
|
|
`eval-last-sexp', and `eval-print-last-sexp'.
|
|
|
|
|
|
|
|
|
|
You can use the command `edebug-all-defs' to toggle the value of this
|
1994-04-08 21:39:52 +00:00
|
|
|
|
variable. You may wish to make it local to each buffer with
|
1996-03-20 13:30:16 +00:00
|
|
|
|
\(make-local-variable 'edebug-all-defs) in your
|
1994-03-24 20:38:34 +00:00
|
|
|
|
`emacs-lisp-mode-hook'.")
|
|
|
|
|
|
|
|
|
|
(defvar edebug-all-forms nil
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*Non-nil evaluation of all forms will instrument for Edebug.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
This doesn't apply to loading or evaluations in the minibuffer.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
Use the command `edebug-all-forms' to toggle the value of this option.")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-eval-macro-args nil
|
1994-03-24 20:38:34 +00:00
|
|
|
|
"*Non-nil means all macro call arguments may be evaluated.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
If this variable is nil, the default, Edebug will *not* wrap
|
1994-03-24 20:38:34 +00:00
|
|
|
|
macro call arguments as if they will be evaluated.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
For each macro, a `edebug-form-spec' overrides this option.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
So to specify exceptions for macros that have some arguments evaluated
|
1996-03-20 13:30:16 +00:00
|
|
|
|
and some not, you should specify an `edebug-form-spec'.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
This option is going away soon.")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-stop-before-symbols nil
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*Non-nil causes Edebug to stop before symbols as well as after.
|
|
|
|
|
In any case, a breakpoint or interrupt may stop before a symbol.
|
|
|
|
|
|
|
|
|
|
This option is going away soon.")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-save-windows t
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*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.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
If the value is a list, only the listed windows are saved and
|
|
|
|
|
restored.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
`edebug-toggle-save-windows' may be used to change this variable.")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defvar edebug-save-displayed-buffer-points nil
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*If non-nil, save and restore point in all displayed buffers.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-04-08 21:39:52 +00:00
|
|
|
|
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
|
1992-05-30 23:52:26 +00:00
|
|
|
|
window, the buffer's point will be changed to the window's point.
|
|
|
|
|
|
1994-04-08 21:39:52 +00:00
|
|
|
|
Saving and restoring point in all buffers is expensive, since it
|
|
|
|
|
requires selecting each window twice, so enable this only if you need
|
|
|
|
|
it.")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-initial-mode 'step
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*Initial execution mode for Edebug, if non-nil. If this variable
|
|
|
|
|
is non-@code{nil}, it specifies the initial execution mode for Edebug
|
|
|
|
|
when it is first activated. Possible values are step, next, go,
|
1992-05-30 23:52:26 +00:00
|
|
|
|
Go-nonstop, trace, Trace-fast, continue, and Continue-fast.")
|
|
|
|
|
|
|
|
|
|
(defvar edebug-trace nil
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*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'.")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defvar 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
|
1994-04-08 21:39:52 +00:00
|
|
|
|
results are found.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
Use `edebug-display-freq-count' to display the frequency count and
|
|
|
|
|
coverage information for a definition.")
|
|
|
|
|
|
|
|
|
|
(defvar edebug-continue-kbd-macro nil
|
1994-04-08 21:39:52 +00:00
|
|
|
|
"*If non-nil, continue defining or executing any keyboard macro.
|
|
|
|
|
Use this with caution since it is not debugged.")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defvar edebug-print-length 50
|
1996-03-20 13:30:16 +00:00
|
|
|
|
"*Default value of `print-length' to use while printing results in Edebug.")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defvar edebug-print-level 50
|
1996-03-20 13:30:16 +00:00
|
|
|
|
"*Default value of `print-level' to use while printing results in Edebug.")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defvar edebug-print-circle t
|
1996-03-20 13:30:16 +00:00
|
|
|
|
"*Default value of `print-circle' to use while printing results in Edebug.")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defvar 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.")
|
|
|
|
|
|
|
|
|
|
(defvar edebug-on-error t
|
|
|
|
|
"*Value bound to `debug-on-error' while Edebug is active.
|
|
|
|
|
|
|
|
|
|
If `debug-on-error' is non-nil, that value is still used.
|
|
|
|
|
|
|
|
|
|
If the value is a list of signal names, Edebug will stop when any of
|
|
|
|
|
these errors are signaled from Lisp code whether or not the signal is
|
|
|
|
|
handled by a `condition-case'. This option is useful for debugging
|
|
|
|
|
signals that *are* handled since they would otherwise be missed.
|
|
|
|
|
After execution is resumed, the error is signaled again.")
|
|
|
|
|
|
|
|
|
|
(defvar edebug-on-quit t
|
|
|
|
|
"*Value bound to `debug-on-quit' while Edebug is active.")
|
|
|
|
|
|
1994-04-08 21:39:52 +00:00
|
|
|
|
(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.")
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Form spec utilities.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defmacro def-edebug-spec (symbol 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
|
1996-03-20 13:30:16 +00:00
|
|
|
|
\(naming a function), or a list."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
|
|
|
|
|
|
|
|
|
|
(defmacro def-edebug-form-spec (symbol spec-form)
|
1996-03-20 13:30:16 +00:00
|
|
|
|
"For compatibility with old version. Use `def-edebug-spec' instead."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(message "Obsolete: use def-edebug-spec instead.")
|
|
|
|
|
(def-edebug-spec symbol (eval spec-form)))
|
|
|
|
|
|
|
|
|
|
(defun get-edebug-spec (symbol)
|
|
|
|
|
;; Get the spec of symbol resolving all indirection.
|
|
|
|
|
(let ((edebug-form-spec (get symbol 'edebug-form-spec))
|
|
|
|
|
indirect)
|
|
|
|
|
(while (and (symbolp edebug-form-spec)
|
|
|
|
|
(setq indirect (get edebug-form-spec 'edebug-form-spec)))
|
|
|
|
|
;; (edebug-trace "indirection: %s" edebug-form-spec)
|
|
|
|
|
(setq edebug-form-spec indirect))
|
|
|
|
|
edebug-form-spec
|
|
|
|
|
))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Utilities
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Define edebug-gensym - from old cl.el
|
|
|
|
|
(defvar edebug-gensym-index 0
|
|
|
|
|
"Integer used by `edebug-gensym' to produce new names.")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(defun edebug-gensym (&optional prefix)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
"Generate a fresh uninterned symbol.
|
|
|
|
|
There is an optional argument, PREFIX. PREFIX is the
|
|
|
|
|
string that begins the new name. Most people take just the default,
|
|
|
|
|
except when debugging needs suggest otherwise."
|
|
|
|
|
(if (null prefix)
|
|
|
|
|
(setq prefix "G"))
|
|
|
|
|
(let ((newsymbol nil)
|
|
|
|
|
(newname ""))
|
|
|
|
|
(while (not newsymbol)
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(setq newname (concat prefix (int-to-string edebug-gensym-index)))
|
|
|
|
|
(setq edebug-gensym-index (+ edebug-gensym-index 1))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if (not (intern-soft newname))
|
|
|
|
|
(setq newsymbol (make-symbol newname))))
|
|
|
|
|
newsymbol))
|
|
|
|
|
|
1994-04-08 21:39:52 +00:00
|
|
|
|
;; Only used by CL-like code.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(defun edebug-keywordp (object)
|
|
|
|
|
"Return t if OBJECT is a keyword.
|
|
|
|
|
A keyword is a symbol that starts with `:'."
|
|
|
|
|
(and (symbolp object)
|
|
|
|
|
(= ?: (aref (symbol-name object) 0))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-lambda-list-keywordp (object)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
"Return t if OBJECT is a lambda list keyword.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
A lambda list keyword is a symbol that starts with `&'."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(and (symbolp object)
|
|
|
|
|
(= ?& (aref (symbol-name object) 0))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-last-sexp ()
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Return the last sexp before point in current buffer.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Assumes Emacs Lisp syntax is active.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(car
|
|
|
|
|
(read-from-string
|
|
|
|
|
(buffer-substring
|
|
|
|
|
(save-excursion
|
|
|
|
|
(forward-sexp -1)
|
|
|
|
|
(point))
|
|
|
|
|
(point)))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-window-list ()
|
1996-03-20 13:30:16 +00:00
|
|
|
|
"Return a list of windows, in order of `next-window'."
|
|
|
|
|
;; This doesn't work for epoch.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(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)))
|
|
|
|
|
(nreverse window-list)))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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 ()
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"Return t if there are two windows."
|
|
|
|
|
(and (not (one-window-p))
|
|
|
|
|
(eq (selected-window)
|
|
|
|
|
(next-window (next-window (selected-window))))))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defsubst edebug-lookup-function (object)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(while (and (symbolp object) (fboundp object))
|
|
|
|
|
(setq object (symbol-function object)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
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))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(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."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq object (edebug-lookup-function object))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(if (or (subrp object)
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(byte-code-function-p object)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(and (listp object)
|
|
|
|
|
(eq (car object) 'lambda)
|
|
|
|
|
(listp (car (cdr object)))))
|
|
|
|
|
object))
|
|
|
|
|
|
|
|
|
|
(defun edebug-sort-alist (alist function)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Return the ALIST sorted with comparison function FUNCTION.
|
|
|
|
|
;; This uses 'sort so the sorting is destructive.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(sort alist (function
|
|
|
|
|
(lambda (e1 e2)
|
|
|
|
|
(funcall function (car e1) (car e2))))))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;;(def-edebug-spec edebug-save-restriction t)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Not used. If it is used, def-edebug-spec must be defined before use.
|
|
|
|
|
'(defmacro edebug-save-restriction (&rest body)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"Evaluate BODY while saving the current buffers restriction.
|
|
|
|
|
BODY may change buffer outside of current restriction, unlike
|
|
|
|
|
save-restriction. BODY may change the current buffer,
|
|
|
|
|
and the restriction will be restored to the original buffer,
|
|
|
|
|
and the current buffer remains current.
|
|
|
|
|
Return the result of the last expression in BODY."
|
|
|
|
|
(` (let ((edebug:s-r-beg (point-min-marker))
|
|
|
|
|
(edebug:s-r-end (point-max-marker)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn (,@ body))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer (marker-buffer edebug:s-r-beg))
|
|
|
|
|
(narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Display
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(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,
|
|
|
|
|
;; 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)
|
|
|
|
|
(eq (window-buffer window) buffer))
|
|
|
|
|
window
|
|
|
|
|
(if (eq (window-buffer (selected-window)) buffer)
|
|
|
|
|
(selected-window)
|
|
|
|
|
(edebug-get-buffer-window buffer))))
|
|
|
|
|
(if window
|
|
|
|
|
(select-window window)
|
|
|
|
|
(if (one-window-p)
|
|
|
|
|
(split-window))
|
|
|
|
|
;; (message "next window: %s" (next-window)) (sit-for 1)
|
|
|
|
|
(if (eq (get-buffer-window edebug-trace-buffer) (next-window))
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Don't select trace window
|
1994-03-24 20:38:34 +00:00
|
|
|
|
nil
|
|
|
|
|
(select-window (next-window))))
|
|
|
|
|
(set-window-buffer (selected-window) buffer)
|
|
|
|
|
(set-window-hscroll (selected-window) 0);; should this be??
|
|
|
|
|
;; Selecting the window does not set the buffer until command loop.
|
|
|
|
|
;;(set-buffer buffer)
|
|
|
|
|
)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-current-windows (which-windows)
|
|
|
|
|
;; Get either a full window configuration or some window information.
|
|
|
|
|
(if (listp which-windows)
|
|
|
|
|
(mapcar (function (lambda (window)
|
|
|
|
|
(if (edebug-window-live-p window)
|
|
|
|
|
(list window
|
|
|
|
|
(window-buffer window)
|
|
|
|
|
(window-point window)
|
|
|
|
|
(window-start window)
|
|
|
|
|
(window-hscroll window)))))
|
|
|
|
|
which-windows)
|
|
|
|
|
(current-window-configuration)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-set-windows (window-info)
|
|
|
|
|
;; Set either a full window configuration or some window information.
|
|
|
|
|
(if (listp window-info)
|
|
|
|
|
(mapcar (function
|
|
|
|
|
(lambda (one-window-info)
|
|
|
|
|
(if one-window-info
|
|
|
|
|
(apply (function
|
|
|
|
|
(lambda (window buffer point start hscroll)
|
|
|
|
|
(if (edebug-window-live-p window)
|
|
|
|
|
(progn
|
|
|
|
|
(set-window-buffer window buffer)
|
|
|
|
|
(set-window-point window point)
|
|
|
|
|
(set-window-start window start)
|
|
|
|
|
(set-window-hscroll window hscroll)))))
|
|
|
|
|
one-window-info))))
|
|
|
|
|
window-info)
|
|
|
|
|
(set-window-configuration window-info)))
|
|
|
|
|
|
|
|
|
|
(defalias 'edebug-get-buffer-window 'get-buffer-window)
|
|
|
|
|
(defalias 'edebug-sit-for 'sit-for)
|
|
|
|
|
(defalias 'edebug-input-pending-p 'input-pending-p)
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; 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.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Use the Lisp version of eval-region.
|
|
|
|
|
(require 'eval-reg "eval-reg")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; Save the original read function
|
|
|
|
|
(or (fboundp 'edebug-original-read)
|
|
|
|
|
(defalias 'edebug-original-read (symbol-function 'read)))
|
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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
|
1996-03-20 13:30:16 +00:00
|
|
|
|
STREAM must be the current buffer to do so. Whether it instruments is
|
1994-04-04 21:52:06 +00:00
|
|
|
|
also dependent on the values of `edebug-all-defs' and
|
1994-03-24 20:38:34 +00:00
|
|
|
|
`edebug-all-forms'."
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(or stream (setq stream standard-input))
|
|
|
|
|
(if (eq stream (current-buffer))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-read-and-maybe-wrap-form)
|
|
|
|
|
(edebug-original-read stream)))
|
|
|
|
|
|
|
|
|
|
(or (fboundp 'edebug-original-eval-defun)
|
|
|
|
|
(defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; We should somehow arrange to be able to do this
|
|
|
|
|
;; without actually replacing the eval-defun command.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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
|
1994-04-04 21:52:06 +00:00
|
|
|
|
prefix argument instrument the code for Edebug. If `edebug-all-defs' is
|
1994-03-24 20:38:34 +00:00
|
|
|
|
non-nil, then the code is instrumented *unless* there is a prefix
|
1996-03-20 13:30:16 +00:00
|
|
|
|
argument. If instrumenting, it prints: `Edebug: FUNCTIONNAME'.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
Otherwise, it prints in the minibuffer."
|
|
|
|
|
(interactive "P")
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(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))))
|
|
|
|
|
(if (and (eq (car form) 'defvar)
|
|
|
|
|
(cdr-safe (cdr-safe form)))
|
|
|
|
|
(setq form (cons 'defconst (cdr form))))
|
|
|
|
|
(setq edebug-result (eval form))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if (not edebugging)
|
|
|
|
|
(princ edebug-result)
|
|
|
|
|
edebug-result)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defalias 'edebug-defun 'edebug-eval-top-level-form)
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun edebug-eval-top-level-form ()
|
|
|
|
|
"Evaluate 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,
|
1996-03-20 13:30:16 +00:00
|
|
|
|
or if an error occurs, leave point after it with mark at the original point."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(eval
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Bind edebug-all-forms only while reading, not while evalling
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; but this causes problems while edebugging edebug.
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(let ((edebug-all-forms t)
|
|
|
|
|
(edebug-all-defs t))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-read-top-level-form))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-read-top-level-form ()
|
|
|
|
|
(let ((starting-point (point)))
|
|
|
|
|
(end-of-defun)
|
|
|
|
|
(beginning-of-defun)
|
|
|
|
|
(prog1
|
|
|
|
|
(edebug-read-and-maybe-wrap-form)
|
|
|
|
|
;; Recover point, but only if no error occurred.
|
|
|
|
|
(goto-char starting-point))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Compatibility with old versions.
|
|
|
|
|
(defalias 'edebug-all-defuns 'edebug-all-defs)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-all-defs ()
|
|
|
|
|
"Toggle edebugging of all definitions."
|
|
|
|
|
(interactive)
|
|
|
|
|
(setq edebug-all-defs (not edebug-all-defs))
|
|
|
|
|
(message "Edebugging all definitions is %s."
|
|
|
|
|
(if edebug-all-defs "on" "off")))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-all-forms ()
|
|
|
|
|
"Toggle edebugging of all forms."
|
|
|
|
|
(interactive)
|
|
|
|
|
(setq edebug-all-forms (not edebug-all-forms))
|
|
|
|
|
(message "Edebugging all forms is %s."
|
|
|
|
|
(if edebug-all-forms "on" "off")))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-install-read-eval-functions ()
|
1993-12-31 12:42:06 +00:00
|
|
|
|
(interactive)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; Don't install if already installed.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(if (eq (symbol-function 'read) 'edebug-read) nil
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(elisp-eval-region-install)
|
|
|
|
|
(defalias 'read 'edebug-read)
|
|
|
|
|
(defalias 'eval-defun 'edebug-eval-defun)))
|
1992-06-24 05:09:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-uninstall-read-eval-functions ()
|
|
|
|
|
(interactive)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(elisp-eval-region-uninstall)
|
|
|
|
|
(defalias 'read (symbol-function 'edebug-original-read))
|
|
|
|
|
(defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Edebug internal data
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; The internal data that is needed for edebugging is kept in the
|
|
|
|
|
;; buffer-local variable `edebug-form-data'.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(make-variable-buffer-local 'edebug-form-data)
|
|
|
|
|
|
|
|
|
|
(defconst edebug-form-data nil)
|
|
|
|
|
;; A list of entries associating symbols with buffer regions.
|
|
|
|
|
;; This is an automatic buffer local variable. Each entry looks like:
|
|
|
|
|
;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers
|
|
|
|
|
;; are at the beginning and end of an entry level form and @var{symbol} is
|
|
|
|
|
;; a symbol that holds all edebug related information for the form on its
|
|
|
|
|
;; property list.
|
|
|
|
|
|
|
|
|
|
;; In the future, the symbol will be irrelevant and edebug data will
|
|
|
|
|
;; be stored in the definitions themselves rather than in the property
|
|
|
|
|
;; list of a symbol.
|
|
|
|
|
|
|
|
|
|
(defun edebug-make-form-data-entry (symbol begin end)
|
|
|
|
|
(list symbol begin end))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-form-data-name (entry)
|
|
|
|
|
(car entry))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-form-data-begin (entry)
|
|
|
|
|
(nth 1 entry))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-form-data-end (entry)
|
|
|
|
|
(nth 2 entry))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-set-form-data-entry (entry name begin end)
|
|
|
|
|
(setcar entry name);; in case name is changed
|
|
|
|
|
(set-marker (nth 1 entry) begin)
|
|
|
|
|
(set-marker (nth 2 entry) end))
|
|
|
|
|
|
|
|
|
|
(defun edebug-get-form-data-entry (pnt &optional end-point)
|
|
|
|
|
;; Find the edebug form data entry which is closest to PNT.
|
|
|
|
|
;; If END-POINT is supplied, match must be exact.
|
|
|
|
|
;; Return `nil' if none found.
|
|
|
|
|
(let ((rest edebug-form-data)
|
|
|
|
|
closest-entry
|
|
|
|
|
(closest-dist 999999)) ;; need maxint here
|
|
|
|
|
(while (and rest (< 0 closest-dist))
|
|
|
|
|
(let* ((entry (car rest))
|
|
|
|
|
(begin (edebug-form-data-begin entry))
|
|
|
|
|
(dist (- pnt begin)))
|
|
|
|
|
(setq rest (cdr rest))
|
|
|
|
|
(if (and (<= 0 dist)
|
|
|
|
|
(< dist closest-dist)
|
|
|
|
|
(or (not end-point)
|
|
|
|
|
(= end-point (edebug-form-data-end entry)))
|
|
|
|
|
(<= pnt (edebug-form-data-end entry)))
|
|
|
|
|
(setq closest-dist dist
|
|
|
|
|
closest-entry entry))))
|
|
|
|
|
closest-entry))
|
|
|
|
|
|
|
|
|
|
;; Also need to find all contained entries,
|
|
|
|
|
;; and find an entry given a symbol, which should be just assq.
|
|
|
|
|
|
|
|
|
|
(defun edebug-form-data-symbol ()
|
|
|
|
|
;; Return the edebug data symbol of the form where point is in.
|
|
|
|
|
;; If point is not inside a edebuggable form, cause error.
|
|
|
|
|
(or (edebug-form-data-name (edebug-get-form-data-entry (point)))
|
|
|
|
|
(error "Not inside instrumented form")))
|
|
|
|
|
|
|
|
|
|
(defun edebug-make-top-form-data-entry (new-entry)
|
|
|
|
|
;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
|
|
|
|
|
(edebug-clear-form-data-entry new-entry)
|
|
|
|
|
(setq edebug-form-data (cons new-entry edebug-form-data)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-clear-form-data-entry (entry)
|
|
|
|
|
;; If non-nil, clear ENTRY out of the form data.
|
|
|
|
|
;; Maybe clear the markers and delete the symbol's edebug property?
|
|
|
|
|
(if entry
|
|
|
|
|
(progn
|
|
|
|
|
;; Instead of this, we could just find all contained forms.
|
|
|
|
|
;; (put (car entry) 'edebug nil) ;
|
|
|
|
|
;; (mapcar 'edebug-clear-form-data-entry ; dangerous
|
|
|
|
|
;; (get (car entry) 'edebug-dependents))
|
|
|
|
|
;; (set-marker (nth 1 entry) nil)
|
|
|
|
|
;; (set-marker (nth 2 entry) nil)
|
|
|
|
|
(setq edebug-form-data (delq entry edebug-form-data)))))
|
1992-06-24 05:09:26 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Parser utilities
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-syntax-error (&rest args)
|
|
|
|
|
;; Signal an invalid-read-syntax with ARGS.
|
|
|
|
|
(signal 'invalid-read-syntax args))
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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))
|
|
|
|
|
(i 0))
|
|
|
|
|
(while (< i ?!)
|
|
|
|
|
(aset table i 'space)
|
|
|
|
|
(setq i (1+ i)))
|
|
|
|
|
(aset table ?\( 'lparen)
|
|
|
|
|
(aset table ?\) 'rparen)
|
|
|
|
|
(aset table ?\' 'quote)
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(aset table ?\` 'backquote)
|
|
|
|
|
(aset table ?\, 'comma)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(aset table ?\" 'string)
|
|
|
|
|
(aset table ?\? 'char)
|
|
|
|
|
(aset table ?\[ 'lbracket)
|
|
|
|
|
(aset table ?\] 'rbracket)
|
|
|
|
|
(aset table ?\. 'dot)
|
|
|
|
|
(aset table ?\# 'hash)
|
|
|
|
|
;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; We don't care about any other chars since they won't be seen.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
table))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-next-token-class ()
|
|
|
|
|
;; Move to the next token and return its class. We only care about
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; lparen, rparen, dot, quote, backquote, comma, string, char, vector,
|
|
|
|
|
;; or symbol.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-skip-whitespace)
|
|
|
|
|
(aref edebug-read-syntax-table (following-char)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-skip-whitespace ()
|
|
|
|
|
;; Leave point before the next token, skipping white space and comments.
|
|
|
|
|
(skip-chars-forward " \t\r\n\f")
|
|
|
|
|
(while (= (following-char) ?\;)
|
|
|
|
|
;; \r is counted as a comment terminator to support selective display.
|
|
|
|
|
(skip-chars-forward "^\n\r") ; skip the comment
|
|
|
|
|
(skip-chars-forward " \t\r\n\f")))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Mostly obsolete reader; still used in one case.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-read-sexp ()
|
|
|
|
|
;; Read one sexp from the current buffer starting at point.
|
|
|
|
|
;; Leave point immediately after it. A sexp can be a list or atom.
|
|
|
|
|
;; An atom is a symbol (or number), character, string, or vector.
|
|
|
|
|
;; This works for reading anything legitimate, but it
|
|
|
|
|
;; is gummed up by parser inconsistencies (bugs?)
|
|
|
|
|
(let ((class (edebug-next-token-class)))
|
|
|
|
|
(cond
|
|
|
|
|
;; read goes one too far if a (possibly quoted) string or symbol
|
|
|
|
|
;; is immediately followed by non-whitespace.
|
|
|
|
|
((eq class 'symbol) (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 'quote) (forward-char 1)
|
|
|
|
|
(list 'quote (edebug-read-sexp)))
|
1996-03-20 13:30:16 +00:00
|
|
|
|
((eq class 'backquote)
|
|
|
|
|
(list '\` (edebug-read-sexp)))
|
|
|
|
|
((eq class 'comma)
|
|
|
|
|
(list '\, (edebug-read-sexp)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(t ; anything else, just read it.
|
|
|
|
|
(edebug-original-read (current-buffer))))))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Offsets for reader
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; 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)
|
|
|
|
|
|
|
|
|
|
;; 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.
|
|
|
|
|
|
|
|
|
|
;; 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)
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-initialize-offsets ()
|
|
|
|
|
;; Reinitialize offset recording.
|
|
|
|
|
(setq edebug-current-offset nil))
|
|
|
|
|
|
|
|
|
|
(defun edebug-store-before-offset (point)
|
|
|
|
|
;; Add a new offset pair with POINT as the before offset.
|
|
|
|
|
(let ((new-offset (list point)))
|
|
|
|
|
(if edebug-current-offset
|
|
|
|
|
(setcdr edebug-current-offset
|
|
|
|
|
(cons new-offset (cdr edebug-current-offset)))
|
|
|
|
|
;; Otherwise, we are at the top level, so initialize.
|
|
|
|
|
(setq edebug-offsets new-offset
|
|
|
|
|
edebug-offsets-stack nil
|
|
|
|
|
edebug-read-dotted-list nil))
|
|
|
|
|
;; Cons the new offset to the front of the stack.
|
|
|
|
|
(setq edebug-offsets-stack (cons new-offset edebug-offsets-stack)
|
|
|
|
|
edebug-current-offset new-offset)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-store-after-offset (point)
|
|
|
|
|
;; Finalize the current offset struct by reversing it and
|
|
|
|
|
;; store POINT as the after offset.
|
|
|
|
|
(if (not edebug-read-dotted-list)
|
|
|
|
|
;; Just reverse the offsets of all subexpressions.
|
|
|
|
|
(setcdr edebug-current-offset (nreverse (cdr edebug-current-offset)))
|
|
|
|
|
|
|
|
|
|
;; We just read a list after a dot, which will be abbreviated out.
|
|
|
|
|
(setq edebug-read-dotted-list nil)
|
|
|
|
|
;; Drop the corresponding offset pair.
|
|
|
|
|
;; That is, nconc the reverse of the rest of the offsets
|
|
|
|
|
;; with the cdr of last offset.
|
|
|
|
|
(setcdr edebug-current-offset
|
|
|
|
|
(nconc (nreverse (cdr (cdr edebug-current-offset)))
|
|
|
|
|
(cdr (car (cdr edebug-current-offset))))))
|
|
|
|
|
|
|
|
|
|
;; Now append the point using nconc.
|
|
|
|
|
(setq edebug-current-offset (nconc edebug-current-offset point))
|
|
|
|
|
;; Pop the stack.
|
|
|
|
|
(setq edebug-offsets-stack (cdr edebug-offsets-stack)
|
|
|
|
|
edebug-current-offset (car edebug-offsets-stack)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-ignore-offset ()
|
|
|
|
|
;; Ignore the last created offset pair.
|
|
|
|
|
(setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))
|
|
|
|
|
|
|
|
|
|
(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)))))
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Reader for Emacs Lisp.
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.
|
|
|
|
|
|
|
|
|
|
(defconst edebug-read-alist
|
|
|
|
|
'((symbol . edebug-read-symbol)
|
|
|
|
|
(lparen . edebug-read-list)
|
|
|
|
|
(string . edebug-read-string)
|
|
|
|
|
(quote . edebug-read-quote)
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(backquote . edebug-read-backquote)
|
|
|
|
|
(comma . edebug-read-comma)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(lbracket . edebug-read-vector)
|
|
|
|
|
(hash . edebug-read-function)
|
|
|
|
|
))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-read-storing-offsets (stream)
|
|
|
|
|
(let ((class (edebug-next-token-class))
|
|
|
|
|
func
|
|
|
|
|
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))
|
|
|
|
|
)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-read-string (stream)
|
|
|
|
|
(prog1
|
|
|
|
|
(edebug-original-read stream)
|
|
|
|
|
(if (/= (preceding-char) ?\")
|
|
|
|
|
(forward-char -1))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-read-quote (stream)
|
|
|
|
|
;; Turn 'thing into (quote thing)
|
|
|
|
|
(forward-char 1)
|
|
|
|
|
(list
|
|
|
|
|
(edebug-storing-offsets (point) 'quote)
|
|
|
|
|
(edebug-read-storing-offsets stream)))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(defun edebug-read-backquote (stream)
|
|
|
|
|
;; Turn `thing into (\` thing)
|
|
|
|
|
(let ((opoint (point)))
|
|
|
|
|
(forward-char 1)
|
|
|
|
|
;; Generate the same structure of offsets we would have
|
|
|
|
|
;; if the resulting list appeared verbatim in the input text.
|
|
|
|
|
(edebug-storing-offsets opoint
|
|
|
|
|
(list
|
|
|
|
|
(edebug-storing-offsets opoint '\`)
|
|
|
|
|
(edebug-read-storing-offsets stream)))))
|
|
|
|
|
|
|
|
|
|
(defvar edebug-read-backquote-new nil
|
|
|
|
|
"Non-nil if reading the inside of a new-style backquote with no parens around it.
|
|
|
|
|
Value of nil means reading the inside of an old-style backquote construct
|
|
|
|
|
which is surrounded by an extra set of parentheses.
|
|
|
|
|
This controls how we read comma constructs.")
|
|
|
|
|
|
|
|
|
|
(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 edebug-read-backquote-new
|
|
|
|
|
(list
|
|
|
|
|
(edebug-storing-offsets opoint symbol)
|
|
|
|
|
(edebug-read-storing-offsets stream))
|
|
|
|
|
(edebug-storing-offsets opoint symbol)))))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-read-list (stream)
|
|
|
|
|
(forward-char 1) ; skip \(
|
|
|
|
|
(prog1
|
|
|
|
|
(let ((elements))
|
|
|
|
|
(while (not (memq (edebug-next-token-class) '(rparen dot)))
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(if (eq (edebug-next-token-class) 'backquote)
|
|
|
|
|
(let ((edebug-read-backquote-new (not (null elements)))
|
|
|
|
|
(opoint (point)))
|
|
|
|
|
(if edebug-read-backquote-new
|
|
|
|
|
(setq elements (cons (edebug-read-backquote stream) elements))
|
|
|
|
|
(forward-char 1) ; Skip backquote.
|
|
|
|
|
;; Call edebug-storing-offsets here so that we
|
|
|
|
|
;; produce the same offsets we would have had
|
|
|
|
|
;; if the backquote were an ordinary symbol.
|
|
|
|
|
(setq elements (cons (edebug-storing-offsets opoint '\`)
|
|
|
|
|
elements))))
|
|
|
|
|
(setq elements (cons (edebug-read-storing-offsets stream) elements))))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq elements (nreverse elements))
|
|
|
|
|
(if (eq 'dot (edebug-next-token-class))
|
|
|
|
|
(let (dotted-form)
|
|
|
|
|
(forward-char 1) ; skip \.
|
|
|
|
|
(setq dotted-form (edebug-read-storing-offsets stream))
|
|
|
|
|
elements (nconc elements dotted-form)
|
|
|
|
|
(if (not (eq (edebug-next-token-class) 'rparen))
|
|
|
|
|
(edebug-syntax-error "Expected `)'"))
|
|
|
|
|
(setq edebug-read-dotted-list (listp dotted-form))
|
|
|
|
|
))
|
|
|
|
|
elements)
|
|
|
|
|
(forward-char 1) ; skip \)
|
|
|
|
|
))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-read-vector (stream)
|
|
|
|
|
(forward-char 1) ; skip \[
|
|
|
|
|
(prog1
|
|
|
|
|
(let ((elements))
|
|
|
|
|
(while (not (eq 'rbracket (edebug-next-token-class)))
|
|
|
|
|
(setq elements (cons (edebug-read-storing-offsets stream) elements)))
|
|
|
|
|
(apply 'vector (nreverse elements)))
|
|
|
|
|
(forward-char 1) ; skip \]
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Cursors for traversal of list and vector elements with offsets.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-dotted-spec nil)
|
|
|
|
|
|
|
|
|
|
(defun edebug-new-cursor (expressions offsets)
|
|
|
|
|
;; Return a new cursor for EXPRESSIONS with OFFSETS.
|
|
|
|
|
(if (vectorp expressions)
|
|
|
|
|
(setq expressions (append expressions nil)))
|
|
|
|
|
(cons expressions offsets))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-set-cursor (cursor expressions offsets)
|
|
|
|
|
;; Set the CURSOR's EXPRESSIONS and OFFSETS to the given.
|
|
|
|
|
;; Return the cursor.
|
|
|
|
|
(setcar cursor expressions)
|
|
|
|
|
(setcdr cursor offsets)
|
|
|
|
|
cursor)
|
|
|
|
|
|
|
|
|
|
'(defun edebug-copy-cursor (cursor)
|
|
|
|
|
;; Copy the cursor using the same object and offsets.
|
|
|
|
|
(cons (car cursor) (cdr cursor)))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-cursor-expressions (cursor)
|
|
|
|
|
(car cursor))
|
|
|
|
|
(defsubst edebug-cursor-offsets (cursor)
|
|
|
|
|
(cdr cursor))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-empty-cursor (cursor)
|
|
|
|
|
;; Return non-nil if CURSOR is empty - meaning no more elements.
|
|
|
|
|
(null (car cursor)))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-top-element (cursor)
|
|
|
|
|
;; Return the top element at the cursor.
|
|
|
|
|
;; Assumes not empty.
|
|
|
|
|
(car (car cursor)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-top-element-required (cursor &rest error)
|
|
|
|
|
;; Check if a dotted form is required.
|
|
|
|
|
(if edebug-dotted-spec (edebug-no-match cursor "Dot expected."))
|
|
|
|
|
;; Check if there is at least one more argument.
|
|
|
|
|
(if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error))
|
|
|
|
|
;; Return that top element.
|
|
|
|
|
(edebug-top-element cursor))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-top-offset (cursor)
|
|
|
|
|
;; Return the top offset pair corresponding to the top element.
|
|
|
|
|
(car (cdr cursor)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-move-cursor (cursor)
|
|
|
|
|
;; Advance and return the cursor to the next element and offset.
|
|
|
|
|
;; throw no-match if empty before moving.
|
|
|
|
|
;; 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)
|
|
|
|
|
(edebug-no-match cursor "Not enough arguments."))
|
|
|
|
|
(setcar cursor (cdr (car cursor)))
|
|
|
|
|
(setcdr cursor (cdr (cdr cursor)))
|
|
|
|
|
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,
|
|
|
|
|
;; which is the after offset for a list.
|
|
|
|
|
(let ((offset (edebug-cursor-offsets cursor)))
|
|
|
|
|
(if (consp offset)
|
|
|
|
|
(car (car offset))
|
|
|
|
|
(1- offset))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-after-offset (cursor)
|
|
|
|
|
;; Return the after offset of the cursor object.
|
|
|
|
|
(let ((offset (edebug-top-offset cursor)))
|
|
|
|
|
(while (consp offset)
|
|
|
|
|
(setq offset (cdr offset)))
|
|
|
|
|
offset))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; The Parser
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; 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.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; 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:
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; (edebug-after (edebug-before 1) 2 exp)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; 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.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; 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.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; Dynamically bound vars, left unbound, but globally declared.
|
|
|
|
|
;; This is to quiet the byte compiler.
|
|
|
|
|
|
|
|
|
|
;; Window data of the highest definition being wrapped.
|
|
|
|
|
;; This data is shared by all embedded definitions.
|
|
|
|
|
(defvar edebug-top-window-data)
|
|
|
|
|
|
|
|
|
|
(defvar edebug-&optional)
|
|
|
|
|
(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.
|
|
|
|
|
|
|
|
|
|
(defconst edebug-error-point nil)
|
|
|
|
|
(defconst edebug-best-error nil)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-read-and-maybe-wrap-form ()
|
|
|
|
|
;; Read a form and wrap it with edebug calls, if the conditions are right.
|
|
|
|
|
;; 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)
|
|
|
|
|
|
|
|
|
|
(let (result
|
|
|
|
|
edebug-top-window-data
|
|
|
|
|
edebug-def-name;; make sure it is locally nil
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; I don't like these here!!
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-&optional
|
|
|
|
|
edebug-&rest
|
|
|
|
|
edebug-gate
|
|
|
|
|
edebug-best-error
|
|
|
|
|
edebug-error-point
|
|
|
|
|
no-match
|
|
|
|
|
;; Do this once here instead of several times.
|
|
|
|
|
(max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(max-specpdl-size (+ 2000 max-specpdl-size)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq no-match
|
|
|
|
|
(catch 'no-match
|
|
|
|
|
(setq result (edebug-read-and-maybe-wrap-form1))
|
|
|
|
|
nil))
|
|
|
|
|
(if no-match
|
|
|
|
|
(apply 'edebug-syntax-error no-match))
|
|
|
|
|
result))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-read-and-maybe-wrap-form1 ()
|
|
|
|
|
(let (spec
|
|
|
|
|
def-kind
|
|
|
|
|
defining-form-p
|
|
|
|
|
def-name
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; These offset things don't belong here, but to support recursive
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; calls to edebug-read, they need to be here.
|
|
|
|
|
edebug-offsets
|
|
|
|
|
edebug-offsets-stack
|
|
|
|
|
edebug-current-offset ; reset to nil
|
|
|
|
|
)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(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
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(setq def-kind (edebug-original-read (current-buffer))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
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
|
|
|
|
|
(eq 'name (car (cdr spec)))
|
|
|
|
|
(eq 'symbol (edebug-next-token-class)))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(edebug-original-read (current-buffer))))))
|
|
|
|
|
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(cond
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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
|
|
|
|
|
(list (edebug-read-storing-offsets (current-buffer)))
|
|
|
|
|
(list edebug-offsets))))
|
|
|
|
|
(car
|
|
|
|
|
(edebug-make-form-wrapper
|
|
|
|
|
cursor
|
|
|
|
|
(edebug-before-offset cursor)
|
|
|
|
|
(1- (edebug-after-offset cursor))
|
|
|
|
|
(list (cons (symbol-name def-kind) (cdr spec))))))
|
|
|
|
|
|
|
|
|
|
;; Not edebugging this form, so reset the symbol's edebug
|
|
|
|
|
;; property to be just a marker at the definition's source code.
|
|
|
|
|
;; This only works for defs with simple names.
|
|
|
|
|
(put def-name 'edebug (point-marker))
|
|
|
|
|
;; Also nil out dependent defs.
|
|
|
|
|
'(mapcar (function
|
|
|
|
|
(lambda (def)
|
|
|
|
|
(put def-name 'edebug nil)))
|
|
|
|
|
(get def-name 'edebug-dependents))
|
|
|
|
|
(edebug-read-sexp)))
|
|
|
|
|
|
|
|
|
|
;; If all forms are being edebugged, explicitly wrap it.
|
|
|
|
|
(edebug-all-forms
|
|
|
|
|
(let ((cursor (edebug-new-cursor
|
|
|
|
|
(list (edebug-read-storing-offsets (current-buffer)))
|
|
|
|
|
(list edebug-offsets))))
|
|
|
|
|
(edebug-make-form-wrapper
|
|
|
|
|
cursor
|
|
|
|
|
(edebug-before-offset cursor)
|
|
|
|
|
(edebug-after-offset cursor)
|
|
|
|
|
nil)))
|
|
|
|
|
|
|
|
|
|
;; Not a defining form, and not edebugging.
|
|
|
|
|
(t (edebug-read-sexp)))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defvar edebug-def-args) ; args of defining form.
|
|
|
|
|
(defvar edebug-def-interactive) ; is it an emacs interactive function?
|
|
|
|
|
(defvar edebug-inside-func) ;; whether code is inside function context.
|
|
|
|
|
;; Currently def-form sets this to nil; def-body sets it to t.
|
|
|
|
|
|
|
|
|
|
(defun edebug-interactive-p-name ()
|
|
|
|
|
;; Return a unique symbol for the variable used to store the
|
|
|
|
|
;; status of interactive-p for this function.
|
|
|
|
|
(intern (format "edebug-%s-interactive-p" edebug-def-name)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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))))
|
|
|
|
|
(edebug-make-enter-wrapper forms)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-make-enter-wrapper (forms)
|
|
|
|
|
;; Generate the enter wrapper for some forms of a definition.
|
|
|
|
|
;; This is not to be used for the body of other forms, e.g. `while',
|
|
|
|
|
;; 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
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(` (edebug-enter
|
|
|
|
|
(quote (, edebug-def-name))
|
|
|
|
|
(, (if edebug-inside-func
|
|
|
|
|
(` (list (,@
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Doesn't work with more than one def-body!!
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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-inc-offset (offset)
|
|
|
|
|
;; modifies edebug-offset-index and edebug-offset-list
|
|
|
|
|
;; accesses edebug-func-marc and buffer point
|
|
|
|
|
(prog1
|
|
|
|
|
edebug-offset-index
|
|
|
|
|
(setq edebug-offset-list (cons (- offset edebug-form-begin-marker)
|
|
|
|
|
edebug-offset-list)
|
|
|
|
|
edebug-offset-index (1+ edebug-offset-index))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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:
|
|
|
|
|
;; (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,
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; then don't call edebug-before.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(list 'edebug-after
|
|
|
|
|
(list 'edebug-before before-index)
|
|
|
|
|
after-index form))
|
|
|
|
|
|
|
|
|
|
(defun edebug-make-after-form (form after-index)
|
|
|
|
|
;; Like edebug-make-before-and-after-form, but only after.
|
|
|
|
|
(list 'edebug-after 0 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
|
|
|
|
|
expressions; a `progn' form will be returned enclosing these forms."
|
|
|
|
|
(if (consp sexp)
|
|
|
|
|
(cond
|
|
|
|
|
((eq 'edebug-after (car sexp))
|
|
|
|
|
(nth 3 sexp))
|
|
|
|
|
((eq 'edebug-enter (car sexp))
|
|
|
|
|
(let ((forms (nthcdr 2 (nth 1 (nth 3 sexp)))))
|
|
|
|
|
(if (> (length forms) 1)
|
|
|
|
|
(cons 'progn forms) ;; could return (values forms) instead.
|
|
|
|
|
(car forms))))
|
|
|
|
|
(t sexp);; otherwise it is not wrapped, so just return it.
|
|
|
|
|
)
|
|
|
|
|
sexp))
|
|
|
|
|
|
|
|
|
|
(defun edebug-unwrap* (sexp)
|
|
|
|
|
"Return the sexp recursively unwrapped."
|
|
|
|
|
(let ((new-sexp (edebug-unwrap sexp)))
|
|
|
|
|
(while (not (eq sexp new-sexp))
|
|
|
|
|
(setq sexp new-sexp
|
|
|
|
|
new-sexp (edebug-unwrap sexp)))
|
|
|
|
|
(if (consp new-sexp)
|
|
|
|
|
(mapcar 'edebug-unwrap* new-sexp)
|
|
|
|
|
new-sexp)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-defining-form (cursor form-begin form-end speclist)
|
|
|
|
|
;; Process the defining form, starting outside the form.
|
|
|
|
|
;; The speclist is a generated list spec that looks like:
|
|
|
|
|
;; (("def-symbol" defining-form-spec-sans-&define))
|
|
|
|
|
;; Skip the first offset.
|
|
|
|
|
(edebug-set-cursor cursor (edebug-cursor-expressions cursor)
|
|
|
|
|
(cdr (edebug-cursor-offsets cursor)))
|
|
|
|
|
(edebug-make-form-wrapper
|
|
|
|
|
cursor
|
|
|
|
|
form-begin (1- form-end)
|
|
|
|
|
speclist))
|
|
|
|
|
|
|
|
|
|
(defun edebug-make-form-wrapper (cursor form-begin form-end
|
|
|
|
|
&optional speclist)
|
|
|
|
|
;; Wrap a form, usually a defining form, but any evaluated one.
|
|
|
|
|
;; If speclist is non-nil, this is being called by edebug-defining-form.
|
|
|
|
|
;; Otherwise it is being called from edebug-read-and-maybe-wrap-form1.
|
|
|
|
|
;; 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-data-begin form-data-entry)
|
|
|
|
|
;; Buffer must be current-buffer for this to work:
|
|
|
|
|
(set-marker (make-marker) form-begin))))
|
|
|
|
|
|
|
|
|
|
(let (edebug-offset-list
|
|
|
|
|
(edebug-offset-index 0)
|
|
|
|
|
result
|
|
|
|
|
;; For definitions.
|
|
|
|
|
;; (edebug-containing-def-name edebug-def-name)
|
|
|
|
|
;; Get name from form-data, if any.
|
|
|
|
|
(edebug-old-def-name (edebug-form-data-name form-data-entry))
|
|
|
|
|
edebug-def-name
|
|
|
|
|
edebug-def-args
|
|
|
|
|
edebug-def-interactive
|
|
|
|
|
edebug-inside-func;; whether wrapped code executes inside a function.
|
|
|
|
|
)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq result
|
|
|
|
|
(if speclist
|
|
|
|
|
(edebug-match cursor speclist)
|
|
|
|
|
|
|
|
|
|
;; else wrap as an enter-form.
|
|
|
|
|
(edebug-make-enter-wrapper (list (edebug-form cursor)))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Set the name here if it was not set by edebug-make-enter-wrapper.
|
|
|
|
|
(setq edebug-def-name
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; 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
|
|
|
|
|
'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
|
|
|
|
|
(edebug-make-form-data-entry
|
|
|
|
|
edebug-def-name
|
|
|
|
|
edebug-form-begin-marker
|
|
|
|
|
;; Buffer must be current-buffer.
|
|
|
|
|
(set-marker (make-marker) form-end)
|
|
|
|
|
))
|
|
|
|
|
(edebug-set-form-data-entry
|
|
|
|
|
form-data-entry edebug-def-name ;; in case name is changed
|
|
|
|
|
form-begin form-end))
|
|
|
|
|
|
|
|
|
|
;; (message "defining: %s" edebug-def-name) (sit-for 2)
|
|
|
|
|
(edebug-make-top-form-data-entry form-data-entry)
|
|
|
|
|
(message "Edebug: %s" edebug-def-name)
|
|
|
|
|
;;(debug edebug-def-name)
|
|
|
|
|
|
|
|
|
|
;; Destructively reverse edebug-offset-list and make vector from it.
|
|
|
|
|
(setq edebug-offset-list (vconcat (nreverse edebug-offset-list)))
|
|
|
|
|
|
|
|
|
|
;; Side effects on the property list of edebug-def-name.
|
|
|
|
|
(edebug-clear-frequency-count edebug-def-name)
|
|
|
|
|
(edebug-clear-coverage edebug-def-name)
|
|
|
|
|
|
|
|
|
|
;; Set up the initial window data.
|
|
|
|
|
(if (not edebug-top-window-data) ;; if not already set, do it now.
|
|
|
|
|
(let ((window ;; Find the best window for this buffer.
|
|
|
|
|
(or (get-buffer-window (current-buffer))
|
|
|
|
|
(selected-window))))
|
|
|
|
|
(setq edebug-top-window-data
|
|
|
|
|
(cons window (window-start window)))))
|
|
|
|
|
|
|
|
|
|
;; Store the edebug data in symbol's property list.
|
|
|
|
|
(put edebug-def-name 'edebug
|
|
|
|
|
;; A struct or vector would be better here!!
|
|
|
|
|
(list edebug-form-begin-marker
|
|
|
|
|
nil ; clear breakpoints
|
|
|
|
|
edebug-offset-list
|
|
|
|
|
edebug-top-window-data
|
|
|
|
|
))
|
|
|
|
|
result
|
1992-05-30 23:52:26 +00:00
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-clear-frequency-count (name)
|
|
|
|
|
;; Create initial frequency count vector.
|
|
|
|
|
;; For each stop point, the counter is incremented each time it is visited.
|
|
|
|
|
(put name 'edebug-freq-count
|
|
|
|
|
(make-vector (length edebug-offset-list) 0)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-clear-coverage (name)
|
|
|
|
|
;; Create initial coverage vector.
|
|
|
|
|
;; Only need one per expression, but it is simpler to use stop points.
|
|
|
|
|
(put name 'edebug-coverage
|
|
|
|
|
(make-vector (length edebug-offset-list) 'unknown)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-form (cursor)
|
|
|
|
|
;; 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)))
|
|
|
|
|
(prog1
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(cond
|
1994-03-24 20:38:34 +00:00
|
|
|
|
((consp form)
|
|
|
|
|
;; The first offset for a list form is for the list form itself.
|
|
|
|
|
(if (eq 'quote (car form))
|
|
|
|
|
form
|
|
|
|
|
(let* ((head (car form))
|
|
|
|
|
(spec (and (symbolp head) (get-edebug-spec head)))
|
|
|
|
|
(new-cursor (edebug-new-cursor form offset)))
|
|
|
|
|
;; 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
|
|
|
|
|
(car offset);; before the form
|
|
|
|
|
(edebug-after-offset cursor)
|
|
|
|
|
(cons (symbol-name head) (cdr spec)))
|
|
|
|
|
;; Wrap a regular 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
|
|
|
|
|
;; with the offset after the form.
|
|
|
|
|
(edebug-inc-offset (edebug-cursor-offsets new-cursor))))
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
((symbolp form)
|
|
|
|
|
(cond
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Check for constant symbols that don't get wrapped.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
((or (memq form '(t nil))
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(and (fboundp 'edebug-keywordp) (edebug-keywordp form)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
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))))))
|
|
|
|
|
|
|
|
|
|
;; Anything else is self-evaluating.
|
|
|
|
|
(t form))
|
|
|
|
|
(edebug-move-cursor cursor))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-forms (cursor) (edebug-match cursor '(&rest form)))
|
|
|
|
|
(defsubst edebug-sexps (cursor) (edebug-match cursor '(&rest sexp)))
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-list-form-args (head cursor)
|
|
|
|
|
;; Process the arguments of a list form given that head of form is a symbol.
|
|
|
|
|
;; Helper for edebug-list-form
|
|
|
|
|
(let ((spec (get-edebug-spec head)))
|
|
|
|
|
(cond
|
|
|
|
|
(spec
|
|
|
|
|
(cond
|
|
|
|
|
((consp spec)
|
|
|
|
|
;; It is a speclist.
|
|
|
|
|
(let (edebug-best-error
|
|
|
|
|
edebug-error-point);; This may not be needed.
|
|
|
|
|
(edebug-match-sublist cursor spec)))
|
|
|
|
|
((eq t spec) (edebug-forms cursor))
|
|
|
|
|
((eq 0 spec) (edebug-sexps cursor))
|
|
|
|
|
((symbolp spec) (funcall spec cursor));; Not used by edebug,
|
|
|
|
|
; but leave it in for compatibility.
|
|
|
|
|
))
|
|
|
|
|
;; No edebug-form-spec provided.
|
|
|
|
|
((edebug-macrop head)
|
|
|
|
|
(if edebug-eval-macro-args
|
|
|
|
|
(edebug-forms cursor)
|
|
|
|
|
(edebug-sexps cursor)))
|
|
|
|
|
(t ;; Otherwise it is a function call.
|
|
|
|
|
(edebug-forms cursor)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-list-form (cursor)
|
|
|
|
|
;; Return an instrumented form built from the list form.
|
|
|
|
|
;; The after offset will be left in the cursor after processing the form.
|
|
|
|
|
(let ((head (edebug-top-element-required cursor "Expected elements"))
|
|
|
|
|
;; Prevent backtracking whenever instrumenting.
|
|
|
|
|
(edebug-gate t)
|
|
|
|
|
;; A list form is never optional because it matches anything.
|
|
|
|
|
(edebug-&optional nil)
|
|
|
|
|
(edebug-&rest nil))
|
|
|
|
|
;; Skip the first 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"))
|
|
|
|
|
((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
|
|
|
|
|
head (edebug-move-cursor cursor))))))
|
|
|
|
|
|
|
|
|
|
((consp head)
|
|
|
|
|
(if (and (listp head) (eq (car head) ',))
|
|
|
|
|
(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.")))
|
|
|
|
|
))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Matching of specs.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-after-dotted-spec nil)
|
|
|
|
|
|
|
|
|
|
(defvar edebug-matching-depth 0) ;; initial value
|
|
|
|
|
(defconst edebug-max-depth 150) ;; maximum number of matching recursions.
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Failure to match
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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-no-match (cursor &rest edebug-args)
|
|
|
|
|
;; Throw a no-match, or signal an error immediately if gate is active.
|
|
|
|
|
;; Remember this point in case we need to report this error.
|
|
|
|
|
(setq edebug-error-point (or edebug-error-point
|
|
|
|
|
(edebug-before-offset cursor))
|
|
|
|
|
edebug-best-error (or edebug-best-error edebug-args))
|
|
|
|
|
(if (and edebug-gate (not edebug-&optional))
|
|
|
|
|
(progn
|
|
|
|
|
(if edebug-error-point
|
|
|
|
|
(goto-char edebug-error-point))
|
|
|
|
|
(apply 'edebug-syntax-error edebug-args))
|
|
|
|
|
(funcall 'throw 'no-match edebug-args)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-match (cursor specs)
|
|
|
|
|
;; Top level spec matching function.
|
|
|
|
|
;; Used also at each lower level of specs.
|
|
|
|
|
(let (edebug-&optional
|
|
|
|
|
edebug-&rest
|
|
|
|
|
edebug-best-error
|
|
|
|
|
edebug-error-point
|
|
|
|
|
(edebug-gate edebug-gate) ;; locally bound to limit effect
|
|
|
|
|
)
|
|
|
|
|
(edebug-match-specs cursor specs 'edebug-match-specs)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-one-spec (cursor spec)
|
|
|
|
|
;; Match one spec, which is not a keyword &-spec.
|
|
|
|
|
(cond
|
|
|
|
|
((symbolp spec) (edebug-match-symbol cursor spec))
|
|
|
|
|
((vectorp spec) (edebug-match cursor (append spec nil)))
|
|
|
|
|
((stringp spec) (edebug-match-string cursor spec))
|
|
|
|
|
((listp spec) (edebug-match-list cursor spec))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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
|
|
|
|
|
(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)
|
|
|
|
|
(let ((edebug-dotted-spec t));; Containing spec list was dotted.
|
|
|
|
|
(edebug-match-specs cursor (list specs) remainder-handler)))
|
|
|
|
|
|
|
|
|
|
;; Is the form dotted?
|
|
|
|
|
((not (listp (edebug-cursor-expressions cursor)));; allow nil
|
|
|
|
|
(if (not edebug-dotted-spec)
|
|
|
|
|
(edebug-no-match cursor "Dotted spec required."))
|
|
|
|
|
;; Cancel dotted spec and dotted form.
|
|
|
|
|
(let ((edebug-dotted-spec)
|
|
|
|
|
(this-form (edebug-cursor-expressions cursor))
|
|
|
|
|
(this-offset (edebug-cursor-offsets cursor)))
|
|
|
|
|
;; Wrap the form in a list, (by changing the cursor??)...
|
|
|
|
|
(edebug-set-cursor cursor (list this-form) this-offset)
|
|
|
|
|
;; and process normally, then unwrap the result.
|
|
|
|
|
(car (edebug-match-specs cursor specs remainder-handler))))
|
|
|
|
|
|
|
|
|
|
(t;; Process normally.
|
|
|
|
|
(let* ((spec (car specs))
|
|
|
|
|
(rest)
|
|
|
|
|
(first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
|
|
|
|
|
;;(message "spec = %s first char = %s" spec first-char) (sit-for 1)
|
|
|
|
|
(nconc
|
|
|
|
|
(cond
|
|
|
|
|
((eq ?& first-char);; "&" symbols take all following specs.
|
|
|
|
|
(funcall (get-edebug-spec spec) cursor (cdr specs)))
|
|
|
|
|
((eq ?: first-char);; ":" symbols take one following spec.
|
|
|
|
|
(setq rest (cdr (cdr specs)))
|
|
|
|
|
(funcall (get-edebug-spec spec) cursor (car (cdr specs))))
|
|
|
|
|
(t;; Any other normal spec.
|
|
|
|
|
(setq rest (cdr specs))
|
|
|
|
|
(edebug-match-one-spec cursor spec)))
|
|
|
|
|
(funcall remainder-handler cursor rest remainder-handler)))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Define specs for all the symbol specs with functions used to process them.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Perhaps we shouldn't be doing this with edebug-form-specs since the
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; user may want to define macros or functions with the same names.
|
|
|
|
|
;; We could use an internal obarray for these primitive specs.
|
|
|
|
|
|
|
|
|
|
(mapcar
|
|
|
|
|
(function (lambda (pair)
|
|
|
|
|
(put (car pair) 'edebug-form-spec (cdr pair))))
|
|
|
|
|
'((&optional . edebug-match-&optional)
|
|
|
|
|
(&rest . edebug-match-&rest)
|
|
|
|
|
(&or . edebug-match-&or)
|
|
|
|
|
(form . edebug-match-form)
|
|
|
|
|
(sexp . edebug-match-sexp)
|
|
|
|
|
(body . edebug-match-body)
|
|
|
|
|
(&define . edebug-match-&define)
|
|
|
|
|
(name . edebug-match-name)
|
|
|
|
|
(:name . edebug-match-colon-name)
|
|
|
|
|
(arg . edebug-match-arg)
|
|
|
|
|
(def-body . edebug-match-def-body)
|
|
|
|
|
(def-form . edebug-match-def-form)
|
|
|
|
|
;; Less frequently used:
|
|
|
|
|
;; (function . edebug-match-function)
|
|
|
|
|
(lambda-expr . edebug-match-lambda-expr)
|
|
|
|
|
(¬ . edebug-match-¬)
|
|
|
|
|
(&key . edebug-match-&key)
|
|
|
|
|
(place . edebug-match-place)
|
|
|
|
|
(gate . edebug-match-gate)
|
|
|
|
|
;; (nil . edebug-match-nil) not this one - special case it.
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-symbol (cursor symbol)
|
|
|
|
|
;; Match a symbol spec.
|
|
|
|
|
(let* ((spec (get-edebug-spec symbol)))
|
|
|
|
|
(cond
|
|
|
|
|
(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?
|
|
|
|
|
(let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
|
|
|
|
|
;; Special case for edebug-`.
|
|
|
|
|
(if (and (listp sexp) (eq (car sexp) ',))
|
|
|
|
|
(edebug-match cursor '(("," def-form)))
|
|
|
|
|
(if (not (funcall symbol sexp))
|
|
|
|
|
(edebug-no-match cursor symbol "failed"))
|
|
|
|
|
(edebug-move-cursor cursor)
|
|
|
|
|
(list sexp))))
|
|
|
|
|
(t (error "%s is not a form-spec or function" symbol))
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-sexp (cursor)
|
|
|
|
|
(list (prog1 (edebug-top-element-required cursor "Expected sexp")
|
|
|
|
|
(edebug-move-cursor cursor))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-form (cursor)
|
|
|
|
|
(list (edebug-form cursor)))
|
|
|
|
|
|
|
|
|
|
(defalias 'edebug-match-place 'edebug-match-form)
|
|
|
|
|
;; Currently identical to edebug-match-form.
|
|
|
|
|
;; This is for common lisp setf-style place arguments.
|
|
|
|
|
|
|
|
|
|
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-&optional (cursor specs)
|
|
|
|
|
;; Keep matching until one spec fails.
|
|
|
|
|
(edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
|
|
|
|
|
|
|
|
|
|
(defun edebug-&optional-wrapper (cursor specs remainder-handler)
|
|
|
|
|
(let (result
|
|
|
|
|
(edebug-&optional specs)
|
|
|
|
|
(edebug-gate nil)
|
|
|
|
|
(this-form (edebug-cursor-expressions cursor))
|
|
|
|
|
(this-offset (edebug-cursor-offsets cursor)))
|
|
|
|
|
(if (null (catch 'no-match
|
|
|
|
|
(setq result
|
|
|
|
|
(edebug-match-specs cursor specs remainder-handler))
|
|
|
|
|
;; Returning nil means no no-match was thrown.
|
|
|
|
|
nil))
|
|
|
|
|
result
|
|
|
|
|
;; no-match, but don't fail; just reset cursor and return nil.
|
|
|
|
|
(edebug-set-cursor cursor this-form this-offset)
|
|
|
|
|
nil)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-&rest-wrapper (cursor specs remainder-handler)
|
|
|
|
|
(if (null specs) (setq specs edebug-&rest))
|
|
|
|
|
;; Reuse the &optional handler with this as the remainder handler.
|
|
|
|
|
(edebug-&optional-wrapper cursor specs remainder-handler))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-&rest (cursor specs)
|
|
|
|
|
;; Repeatedly use specs until failure.
|
|
|
|
|
(let ((edebug-&rest specs) ;; remember these
|
|
|
|
|
edebug-best-error
|
|
|
|
|
edebug-error-point)
|
|
|
|
|
(edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-&or (cursor specs)
|
|
|
|
|
;; Keep matching until one spec succeeds, and return its results.
|
|
|
|
|
;; If none match, fail.
|
|
|
|
|
;; This needs to be optimized since most specs spend time here.
|
|
|
|
|
(let ((original-specs specs)
|
|
|
|
|
(this-form (edebug-cursor-expressions cursor))
|
|
|
|
|
(this-offset (edebug-cursor-offsets cursor)))
|
|
|
|
|
(catch 'matched
|
|
|
|
|
(while specs
|
|
|
|
|
(catch 'no-match
|
|
|
|
|
(throw 'matched
|
|
|
|
|
(let (edebug-gate ;; only while matching each spec
|
|
|
|
|
edebug-best-error
|
|
|
|
|
edebug-error-point)
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Doesn't support e.g. &or symbolp &rest form
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-match-one-spec cursor (car specs)))))
|
|
|
|
|
;; Match failed, so reset and try again.
|
|
|
|
|
(setq specs (cdr specs))
|
|
|
|
|
;; Reset the cursor for the next match.
|
|
|
|
|
(edebug-set-cursor cursor this-form this-offset))
|
|
|
|
|
;; All failed.
|
|
|
|
|
(apply 'edebug-no-match cursor "Expected one of" original-specs))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-match-¬ (cursor specs)
|
|
|
|
|
;; If any specs match, then fail
|
|
|
|
|
(if (null (catch 'no-match
|
|
|
|
|
(let ((edebug-gate nil))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(edebug-match-&or cursor specs)))
|
|
|
|
|
nil))
|
|
|
|
|
;; This means something matched, so it is a no match.
|
|
|
|
|
(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.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; This really doesn't save much over the expanded form and takes time.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-match-&rest
|
|
|
|
|
cursor
|
|
|
|
|
(cons '&or
|
|
|
|
|
(mapcar (function (lambda (pair)
|
|
|
|
|
(vector (format ":%s" (car pair))
|
|
|
|
|
(car (cdr pair)))))
|
|
|
|
|
specs))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-gate (cursor)
|
|
|
|
|
;; Simply set the gate to prevent backtracking at this level.
|
|
|
|
|
(setq edebug-gate t)
|
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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,
|
|
|
|
|
;; so match list spec elements as if spliced in.
|
|
|
|
|
(prog1
|
|
|
|
|
(let ((edebug-dotted-spec))
|
|
|
|
|
(edebug-match-specs cursor specs 'edebug-match-specs))
|
|
|
|
|
;; If it matched, really clear the dotted-spec flag.
|
|
|
|
|
(setq edebug-dotted-spec nil))
|
|
|
|
|
(let ((spec (car specs))
|
|
|
|
|
(form (edebug-top-element-required cursor "Expected" specs)))
|
|
|
|
|
(cond
|
|
|
|
|
((eq 'quote spec)
|
|
|
|
|
(let ((spec (car (cdr specs))))
|
|
|
|
|
(cond
|
|
|
|
|
((symbolp spec)
|
|
|
|
|
;; Special case: spec quotes a symbol to match.
|
|
|
|
|
;; Change in future. Use "..." instead.
|
|
|
|
|
(if (not (eq spec form))
|
|
|
|
|
(edebug-no-match cursor "Expected" spec))
|
|
|
|
|
(edebug-move-cursor cursor)
|
|
|
|
|
(setq edebug-gate t)
|
|
|
|
|
form)
|
|
|
|
|
(t
|
|
|
|
|
(error "Bad spec: %s" specs)))))
|
|
|
|
|
|
|
|
|
|
((listp form)
|
|
|
|
|
(prog1
|
|
|
|
|
(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)))
|
|
|
|
|
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
|
|
|
|
|
form (cdr (edebug-top-offset cursor)))
|
|
|
|
|
(cdr specs))))
|
|
|
|
|
(edebug-move-cursor cursor)
|
|
|
|
|
(list (apply 'vector result))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(t (edebug-no-match cursor "Expected" specs)))
|
|
|
|
|
)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-match-sublist (cursor specs)
|
|
|
|
|
;; Match a sublist of specs.
|
|
|
|
|
(let (edebug-&optional
|
|
|
|
|
;;edebug-best-error
|
|
|
|
|
;;edebug-error-point
|
|
|
|
|
)
|
|
|
|
|
(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
|
|
|
|
|
(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-string (cursor spec)
|
|
|
|
|
(let ((sexp (edebug-top-element-required cursor "Expected" spec)))
|
|
|
|
|
(if (not (eq (intern spec) sexp))
|
|
|
|
|
(edebug-no-match cursor "Expected" spec)
|
|
|
|
|
;; Since it matched, failure means immediate error, unless &optional.
|
|
|
|
|
(setq edebug-gate t)
|
|
|
|
|
(edebug-move-cursor cursor)
|
|
|
|
|
(list sexp)
|
|
|
|
|
)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-match-nil (cursor)
|
|
|
|
|
;; There must be nothing left to match a nil.
|
|
|
|
|
(if (not (edebug-empty-cursor cursor))
|
|
|
|
|
(edebug-no-match cursor "Unmatched argument(s)")
|
|
|
|
|
nil))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-function (cursor)
|
|
|
|
|
(error "Use function-form instead of function in edebug spec"))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-&define (cursor specs)
|
|
|
|
|
;; Match a defining form.
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; Normally, &define is interpreted specially other places.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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
|
|
|
|
|
(edebug-before-offset cursor)
|
|
|
|
|
;; Find the last offset in the list.
|
|
|
|
|
(let ((offsets (edebug-cursor-offsets cursor)))
|
|
|
|
|
(while (consp offsets) (setq offsets (cdr offsets)))
|
|
|
|
|
offsets)
|
|
|
|
|
specs))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-lambda-expr (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.
|
|
|
|
|
;; I could add a &lambda specification to avoid confusion.
|
|
|
|
|
(let* ((sexp (edebug-top-element-required
|
|
|
|
|
cursor "Expected lambda expression"))
|
|
|
|
|
(offset (edebug-top-offset cursor))
|
|
|
|
|
(head (and (consp sexp) (car sexp)))
|
|
|
|
|
(spec (and (symbolp head) (get-edebug-spec head)))
|
|
|
|
|
(edebug-inside-func nil))
|
|
|
|
|
;; Find out if this is a defining form from first symbol.
|
|
|
|
|
(if (and (consp spec) (eq '&define (car spec)))
|
|
|
|
|
(prog1
|
|
|
|
|
(list
|
|
|
|
|
(edebug-defining-form
|
|
|
|
|
(edebug-new-cursor sexp offset)
|
|
|
|
|
(car offset);; before the sexp
|
|
|
|
|
(edebug-after-offset cursor)
|
|
|
|
|
(cons (symbol-name head) (cdr spec))))
|
|
|
|
|
(edebug-move-cursor cursor))
|
|
|
|
|
(edebug-no-match cursor "Expected lambda expression")
|
|
|
|
|
)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-match-name (cursor)
|
|
|
|
|
;; Set the edebug-def-name bound in edebug-defining-form.
|
|
|
|
|
(let ((name (edebug-top-element-required cursor "Expected name")))
|
|
|
|
|
;; Maybe strings and numbers could be used.
|
|
|
|
|
(if (not (symbolp name))
|
|
|
|
|
(edebug-no-match cursor "Symbol expected for name of definition"))
|
|
|
|
|
(setq edebug-def-name
|
|
|
|
|
(if edebug-def-name
|
|
|
|
|
;; Construct a new name by appending to previous name.
|
|
|
|
|
(intern (format "%s@%s" edebug-def-name name))
|
|
|
|
|
name))
|
|
|
|
|
(edebug-move-cursor cursor)
|
|
|
|
|
(list name)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-colon-name (cursor spec)
|
|
|
|
|
;; Set the edebug-def-name to the spec.
|
|
|
|
|
(setq edebug-def-name
|
|
|
|
|
(if edebug-def-name
|
|
|
|
|
;; Construct a new name by appending to previous name.
|
|
|
|
|
(intern (format "%s@%s" edebug-def-name spec))
|
|
|
|
|
spec))
|
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-arg (cursor)
|
|
|
|
|
;; 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))
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(edebug-lambda-list-keywordp edebug-arg))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-no-match cursor "Bad argument:" edebug-arg))
|
|
|
|
|
(edebug-move-cursor cursor)
|
|
|
|
|
(setq edebug-def-args (cons edebug-arg edebug-def-args))
|
|
|
|
|
(list edebug-arg)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-def-form (cursor)
|
|
|
|
|
;; Like form but the form is wrapped in edebug-enter form.
|
|
|
|
|
;; The form is assumed to be executing outside of the function context.
|
|
|
|
|
;; This is a hack for now, since a def-form might execute inside as well.
|
|
|
|
|
;; Not to be used otherwise.
|
|
|
|
|
(let ((edebug-inside-func nil))
|
|
|
|
|
(list (edebug-make-enter-wrapper (list (edebug-form cursor))))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-match-def-body (cursor)
|
|
|
|
|
;; Like body but body is wrapped in edebug-enter form.
|
|
|
|
|
;; The body is assumed to be executing inside of the function context.
|
|
|
|
|
;; Not to be used otherwise.
|
|
|
|
|
(let ((edebug-inside-func t))
|
|
|
|
|
(list (edebug-wrap-def-body (edebug-forms cursor)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;; Edebug Form Specs
|
|
|
|
|
;;; ==========================================================
|
|
|
|
|
;;; See cl-specs.el for common lisp specs.
|
|
|
|
|
|
|
|
|
|
;;;;* Spec for def-edebug-spec
|
|
|
|
|
;;; Out of date.
|
|
|
|
|
|
|
|
|
|
(defun edebug-spec-p (object)
|
|
|
|
|
"Return non-nil if OBJECT is a symbol with an edebug-form-spec property."
|
|
|
|
|
(and (symbolp object)
|
|
|
|
|
(get object 'edebug-form-spec)))
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec def-edebug-spec
|
|
|
|
|
;; Top level is different from lower levels.
|
|
|
|
|
(&define :name edebug-spec name
|
|
|
|
|
&or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec edebug-spec-list
|
|
|
|
|
;; A list must have something in it, or it is nil, a symbolp
|
|
|
|
|
((edebug-spec . [&or nil edebug-spec])))
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec edebug-spec
|
|
|
|
|
(&or
|
|
|
|
|
(vector &rest edebug-spec) ; matches a vector
|
|
|
|
|
("vector" &rest edebug-spec) ; matches a vector spec
|
|
|
|
|
("quote" symbolp)
|
|
|
|
|
edebug-spec-list
|
|
|
|
|
stringp
|
1996-03-20 13:30:16 +00:00
|
|
|
|
[edebug-lambda-list-keywordp &rest edebug-spec]
|
|
|
|
|
;; [edebug-keywordp gate edebug-spec] ;; need edebug-keywordp for this.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-spec-p ;; Including all the special ones e.g. form.
|
|
|
|
|
symbolp;; a predicate
|
|
|
|
|
))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;;* Emacs special forms and some functions.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; quote expects only one argument, although it allows any number.
|
|
|
|
|
(def-edebug-spec quote sexp)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; The standard defining forms.
|
|
|
|
|
(def-edebug-spec defconst defvar)
|
|
|
|
|
(def-edebug-spec defvar (symbolp &optional form stringp))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(def-edebug-spec defun
|
|
|
|
|
(&define name lambda-list
|
|
|
|
|
[&optional stringp]
|
|
|
|
|
[&optional ("interactive" interactive)]
|
|
|
|
|
def-body))
|
|
|
|
|
(def-edebug-spec defmacro
|
|
|
|
|
(&define name lambda-list def-body))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(def-edebug-spec lambda-list
|
|
|
|
|
(([&rest arg]
|
|
|
|
|
[&optional ["&optional" arg &rest arg]]
|
|
|
|
|
&optional ["&rest" arg]
|
|
|
|
|
)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(def-edebug-spec interactive
|
|
|
|
|
(&optional &or stringp def-form))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; A function-form is for an argument that may be a function or a form.
|
|
|
|
|
;; This specially recognizes anonymous functions quoted with quote.
|
|
|
|
|
(def-edebug-spec function-form
|
|
|
|
|
;; form at the end could also handle "function",
|
|
|
|
|
;; but recognize it specially to avoid wrapping function forms.
|
|
|
|
|
(&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; function expects a symbol or a lambda or macro expression
|
|
|
|
|
;; A macro is allowed by Emacs.
|
|
|
|
|
(def-edebug-spec function (&or symbolp lambda-expr))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; lambda is a macro in emacs 19.
|
|
|
|
|
(def-edebug-spec lambda (&define lambda-list
|
|
|
|
|
[&optional stringp]
|
|
|
|
|
[&optional ("interactive" interactive)]
|
|
|
|
|
def-body))
|
|
|
|
|
|
|
|
|
|
;; A macro expression is a lambda expression with "macro" prepended.
|
|
|
|
|
(def-edebug-spec macro (&define "lambda" lambda-list def-body))
|
|
|
|
|
|
|
|
|
|
;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
|
|
|
|
|
|
|
|
|
|
;; Standard functions that take function-forms arguments.
|
|
|
|
|
(def-edebug-spec mapcar (function-form form))
|
|
|
|
|
(def-edebug-spec mapconcat (function-form form form))
|
|
|
|
|
(def-edebug-spec mapatoms (function-form &optional form))
|
|
|
|
|
(def-edebug-spec apply (function-form &rest form))
|
|
|
|
|
(def-edebug-spec funcall (function-form &rest form))
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec let
|
|
|
|
|
((&rest &or (symbolp &optional form) symbolp)
|
|
|
|
|
body))
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec let* let)
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec setq (&rest symbolp form))
|
|
|
|
|
(def-edebug-spec setq-default setq)
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec cond (&rest (&rest form)))
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec condition-case
|
|
|
|
|
(symbolp
|
|
|
|
|
form
|
|
|
|
|
&rest (symbolp body)))
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(def-edebug-spec \` (backquote-form))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; 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)
|
|
|
|
|
;; 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])
|
|
|
|
|
(vector &rest backquote-form)
|
|
|
|
|
sexp))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Special version of backquote that instruments backquoted forms
|
|
|
|
|
;; destined to be evaluated, usually as the result of a
|
|
|
|
|
;; macroexpansion. Backquoted code can only have unquotes (, and ,@)
|
|
|
|
|
;; in places where list forms are allowed, and predicates. If the
|
|
|
|
|
;; backquote is used in a macro, unquoted code that come from
|
|
|
|
|
;; arguments must be instrumented, if at all, with def-form not def-body.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; We could assume that all forms (not nested in other forms)
|
|
|
|
|
;; in arguments of macros should be def-forms, whether or not the macros
|
|
|
|
|
;; are defined with edebug-` but this would be expensive.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; ,@ might have some problems.
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(defalias 'edebug-\` '\`) ;; same macro as regular backquote.
|
|
|
|
|
(def-edebug-spec edebug-\` (def-form))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; Assume immediate quote in unquotes mean backquote at next higher level.
|
|
|
|
|
(def-edebug-spec , (&or ("quote" edebug-`) def-form))
|
|
|
|
|
(def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped.
|
|
|
|
|
&or ("quote" edebug-`) def-form))
|
|
|
|
|
|
|
|
|
|
;; New byte compiler.
|
|
|
|
|
(def-edebug-spec defsubst defun)
|
|
|
|
|
(def-edebug-spec dont-compile t)
|
|
|
|
|
(def-edebug-spec eval-when-compile t)
|
|
|
|
|
(def-edebug-spec eval-and-compile t)
|
|
|
|
|
|
1996-10-02 21:41:56 +00:00
|
|
|
|
(def-edebug-spec save-selected-window t)
|
|
|
|
|
(def-edebug-spec save-current-buffer t)
|
|
|
|
|
(def-edebug-spec save-match-data t)
|
|
|
|
|
(def-edebug-spec with-output-to-string t)
|
|
|
|
|
(def-edebug-spec with-current-buffer t)
|
|
|
|
|
(def-edebug-spec with-temp-file t)
|
|
|
|
|
(def-edebug-spec with-temp-buffer t)
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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
|
|
|
|
|
(&define name ;; thing being advised.
|
|
|
|
|
(name ;; class is [&or "before" "around" "after"
|
|
|
|
|
;; "activation" "deactivation"]
|
|
|
|
|
name ;; name of advice
|
|
|
|
|
&rest sexp ;; optional position and flags
|
|
|
|
|
)
|
|
|
|
|
[&optional stringp]
|
|
|
|
|
[&optional ("interactive" interactive)]
|
|
|
|
|
def-body))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; The debugger itself
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-active nil) ;; Non-nil when edebug is active
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
;;; add minor-mode-alist entry
|
|
|
|
|
(or (assq 'edebug-active minor-mode-alist)
|
|
|
|
|
(setq minor-mode-alist (cons (list 'edebug-active " *Debugging*")
|
|
|
|
|
minor-mode-alist)))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defvar edebug-stack nil)
|
|
|
|
|
;; Stack of active functions evaluated via edebug.
|
|
|
|
|
;; Should be nil at the top level.
|
|
|
|
|
|
|
|
|
|
(defvar edebug-stack-depth -1)
|
|
|
|
|
;; Index of last edebug-stack item.
|
|
|
|
|
|
|
|
|
|
(defvar edebug-offset-indices nil)
|
|
|
|
|
;; Stack of offset indices of visited edebug sexps.
|
|
|
|
|
;; Should be nil at the top level.
|
|
|
|
|
;; Each function adds one cons. Top is modified with setcar.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defvar edebug-entered nil
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Non-nil if edebug has already been entered at this recursive edit level.
|
|
|
|
|
;; This should stay nil at the top level.
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
;; Should these be options?
|
|
|
|
|
(defconst edebug-debugger 'edebug
|
|
|
|
|
;; Name of function to use for debugging when error or quit occurs.
|
|
|
|
|
;; Set this to 'debug if you want to debug edebug.
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Dynamically bound variables, declared globally but left unbound.
|
|
|
|
|
(defvar edebug-function) ; the function being executed. change name!!
|
|
|
|
|
(defvar edebug-args) ; the arguments of the function
|
|
|
|
|
(defvar edebug-data) ; the edebug data for the function
|
|
|
|
|
(defvar edebug-value) ; the result of the expression
|
|
|
|
|
(defvar edebug-after-index)
|
|
|
|
|
(defvar edebug-def-mark) ; the mark for the definition
|
|
|
|
|
(defvar edebug-freq-count) ; the count of expression visits.
|
|
|
|
|
(defvar edebug-coverage) ; the coverage results of each expression of function.
|
|
|
|
|
|
|
|
|
|
(defvar edebug-buffer) ; which buffer the function is in.
|
|
|
|
|
(defvar edebug-result) ; the result of the function call returned by body
|
|
|
|
|
(defvar edebug-outside-executing-macro)
|
|
|
|
|
(defvar edebug-outside-defining-kbd-macro)
|
|
|
|
|
|
|
|
|
|
(defvar edebug-execution-mode 'step) ; Current edebug mode set by user.
|
|
|
|
|
(defvar edebug-next-execution-mode nil) ; Use once instead of initial mode.
|
|
|
|
|
|
|
|
|
|
(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
|
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(defvar edebug-outside-pre-command-hook)
|
|
|
|
|
(defvar edebug-outside-post-command-hook)
|
|
|
|
|
|
|
|
|
|
(defvar cl-lexical-debug) ;; Defined in cl.el
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;;; Handling signals
|
|
|
|
|
|
|
|
|
|
(defun edebug-signal (edebug-signal-name edebug-signal-data)
|
|
|
|
|
"Signal an error. Args are SIGNAL-NAME, and associated DATA.
|
|
|
|
|
A signal name is a symbol with an `error-conditions' property
|
|
|
|
|
that is a list of condition names.
|
|
|
|
|
A handler for any of those names will get to handle this signal.
|
|
|
|
|
The symbol `error' should always be one of them.
|
|
|
|
|
|
|
|
|
|
DATA should be a list. Its elements are printed as part of the error message.
|
|
|
|
|
If the signal is handled, DATA is made available to the handler.
|
|
|
|
|
See `condition-case'.
|
|
|
|
|
|
|
|
|
|
This is the Edebug replacement for the standard `signal'. It should
|
|
|
|
|
only be active while Edebug is. It checks `debug-on-error' to see
|
|
|
|
|
whether it should call the debugger. When execution is resumed, the
|
|
|
|
|
error is signaled again."
|
|
|
|
|
(if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
|
|
|
|
|
(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.
|
1996-09-24 06:54:18 +00:00
|
|
|
|
(signal edebug-signal-name edebug-signal-data))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;;; Entering Edebug
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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.
|
|
|
|
|
;; Return the result of BODY.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
;; Is this the first time we are entering edebug since
|
|
|
|
|
;; lower-level recursive-edit command?
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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,
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; but not inside an unwind-protect.
|
|
|
|
|
;; Doing it here also keeps it from growing too large.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
|
|
|
|
|
(max-specpdl-size (+ 200 max-specpdl-size))
|
|
|
|
|
|
|
|
|
|
(debugger edebug-debugger) ; only while edebug is active.
|
|
|
|
|
(edebug-outside-debug-on-error debug-on-error)
|
|
|
|
|
(edebug-outside-debug-on-quit debug-on-quit)
|
|
|
|
|
;; Binding these may not be the right thing to do.
|
|
|
|
|
;; We want to allow the global values to be changed.
|
|
|
|
|
(debug-on-error (or debug-on-error edebug-on-error))
|
|
|
|
|
(debug-on-quit edebug-on-quit)
|
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; Lexical bindings must be uncompiled for this to work.
|
|
|
|
|
(cl-lexical-debug t)
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Save the outside value of executing macro. (here??)
|
1996-05-29 17:17:34 +00:00
|
|
|
|
(edebug-outside-executing-macro executing-kbd-macro)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(edebug-outside-pre-command-hook pre-command-hook)
|
1996-09-23 04:39:19 +00:00
|
|
|
|
(edebug-outside-post-command-hook post-command-hook))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(unwind-protect
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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.
|
1996-05-29 17:17:34 +00:00
|
|
|
|
(executing-kbd-macro
|
|
|
|
|
(if edebug-continue-kbd-macro executing-kbd-macro))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
|
1996-09-24 06:54:18 +00:00
|
|
|
|
(signal-hook-function 'edebug-signal)
|
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; 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)
|
1996-09-23 04:39:19 +00:00
|
|
|
|
(post-command-hook nil))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(setq edebug-execution-mode (or edebug-next-execution-mode
|
|
|
|
|
edebug-initial-mode
|
|
|
|
|
edebug-execution-mode)
|
|
|
|
|
edebug-next-execution-mode nil)
|
1996-09-24 06:54:18 +00:00
|
|
|
|
(edebug-enter edebug-function edebug-args edebug-body))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; Reset global variables in case outside value was changed.
|
1996-05-29 17:17:34 +00:00
|
|
|
|
(setq executing-kbd-macro edebug-outside-executing-macro
|
1996-03-20 13:30:16 +00:00
|
|
|
|
pre-command-hook edebug-outside-pre-command-hook
|
|
|
|
|
post-command-hook edebug-outside-post-command-hook
|
1994-04-04 21:52:06 +00:00
|
|
|
|
)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
(edebug-coverage (get edebug-function 'edebug-coverage))
|
|
|
|
|
(edebug-buffer (marker-buffer edebug-def-mark))
|
|
|
|
|
|
|
|
|
|
(edebug-stack (cons edebug-function edebug-stack))
|
|
|
|
|
(edebug-offset-indices (cons 0 edebug-offset-indices))
|
|
|
|
|
)
|
|
|
|
|
(if (get edebug-function 'edebug-on-entry)
|
|
|
|
|
(progn
|
|
|
|
|
(setq edebug-execution-mode 'step)
|
|
|
|
|
(if (eq (get edebug-function 'edebug-on-entry) 'temp)
|
|
|
|
|
(put edebug-function 'edebug-on-entry nil))))
|
|
|
|
|
(if edebug-trace
|
|
|
|
|
(edebug-enter-trace edebug-body)
|
|
|
|
|
(funcall edebug-body))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-enter-trace (edebug-body)
|
|
|
|
|
(let ((edebug-stack-depth (1+ edebug-stack-depth))
|
|
|
|
|
edebug-result)
|
|
|
|
|
(edebug-print-trace-before
|
|
|
|
|
(format "%s args: %s" edebug-function edebug-args))
|
|
|
|
|
(prog1 (setq edebug-result (funcall edebug-body))
|
|
|
|
|
(edebug-print-trace-after
|
|
|
|
|
(format "%s result: %s" edebug-function edebug-result)))))
|
|
|
|
|
|
|
|
|
|
(def-edebug-spec edebug-tracing (form body))
|
|
|
|
|
|
|
|
|
|
(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))))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-print-trace-before (msg)
|
|
|
|
|
"Function called to print trace info before expression evaluation.
|
|
|
|
|
MSG is printed after `::::{ '."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-trace-display
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-trace-buffer "%s{ %s" (make-string edebug-stack-depth ?\:) msg))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-print-trace-after (msg)
|
|
|
|
|
"Function called to print trace info after expression evaluation.
|
|
|
|
|
MSG is printed after `::::} '."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-trace-display
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-trace-buffer "%s} %s" (make-string edebug-stack-depth ?\:) msg))
|
|
|
|
|
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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)
|
|
|
|
|
;; Do nothing.
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
(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.
|
|
|
|
|
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.
|
|
|
|
|
edebug-value)
|
|
|
|
|
|
|
|
|
|
(defun edebug-run-slow ()
|
|
|
|
|
(defalias 'edebug-before 'edebug-slow-before)
|
|
|
|
|
(defalias 'edebug-after 'edebug-slow-after))
|
|
|
|
|
|
|
|
|
|
;; This is not used, yet.
|
|
|
|
|
(defun edebug-run-fast ()
|
|
|
|
|
(defalias 'edebug-before 'edebug-fast-before)
|
|
|
|
|
(defalias 'edebug-after 'edebug-fast-after))
|
|
|
|
|
|
|
|
|
|
(edebug-run-slow)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-update-coverage ()
|
|
|
|
|
(let ((old-result (aref edebug-coverage edebug-after-index)))
|
|
|
|
|
(cond
|
|
|
|
|
((eq 'ok-coverage old-result))
|
|
|
|
|
((eq 'unknown old-result)
|
|
|
|
|
(aset edebug-coverage edebug-after-index edebug-value))
|
|
|
|
|
;; Test if a different result.
|
|
|
|
|
((not (eq edebug-value old-result))
|
|
|
|
|
(aset edebug-coverage edebug-after-index 'ok-coverage)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Dynamically declared unbound variables.
|
|
|
|
|
(defvar edebug-arg-mode) ; the mode, either before, after, or error
|
|
|
|
|
(defvar edebug-breakpoints)
|
|
|
|
|
(defvar edebug-break-data) ; break data for current function.
|
|
|
|
|
(defvar edebug-break) ; whether a break occurred.
|
|
|
|
|
(defvar edebug-global-break) ; whether a global break occurred.
|
|
|
|
|
(defvar edebug-break-condition) ; whether the breakpoint is conditional.
|
|
|
|
|
|
|
|
|
|
(defvar edebug-break-result nil)
|
|
|
|
|
(defvar edebug-global-break-result nil)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
|
|
|
|
|
(edebug-break-data (assq edebug-offset-index edebug-breakpoints))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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))))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(if (and edebug-break
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(nth 2 edebug-break-data)) ; is it temporary?
|
1992-05-30 23:52:26 +00:00
|
|
|
|
;; Delete the breakpoint.
|
|
|
|
|
(setcdr edebug-data
|
|
|
|
|
(cons (delq edebug-break-data edebug-breakpoints)
|
|
|
|
|
(cdr (cdr edebug-data)))))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; 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
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-value
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; window-start now stored with each function.
|
|
|
|
|
;;(defvar edebug-window-start nil)
|
|
|
|
|
;; Remember where each buffers' window starts between edebug calls.
|
|
|
|
|
;; This is to avoid spurious recentering.
|
|
|
|
|
;; Does this still need to be buffer-local??
|
|
|
|
|
;;(setq-default edebug-window-start nil)
|
|
|
|
|
;;(make-variable-buffer-local 'edebug-window-start)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Dynamically declared unbound vars
|
|
|
|
|
(defvar edebug-point) ; the point in edebug buffer
|
|
|
|
|
(defvar edebug-outside-buffer) ; the current-buffer outside of edebug
|
|
|
|
|
(defvar edebug-outside-point) ; the point outside of edebug
|
|
|
|
|
(defvar edebug-outside-mark) ; the mark outside of edebug
|
|
|
|
|
(defvar edebug-window-data) ; window and window-start for current function
|
|
|
|
|
(defvar edebug-outside-windows) ; outside window configuration
|
|
|
|
|
(defvar edebug-eval-buffer) ; for the evaluation list.
|
|
|
|
|
(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
|
|
|
|
|
(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
|
|
|
|
|
(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
|
|
|
|
|
|
|
|
|
|
(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
|
|
|
|
|
|
|
|
|
|
(defvar edebug-previous-result nil) ;; Last result returned.
|
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; Emacs 19 adds an arg to mark and mark-marker.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defalias 'edebug-mark 'mark)
|
|
|
|
|
(defalias 'edebug-mark-marker 'mark-marker)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-display ()
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
|
|
|
|
|
;; Uses local variables of edebug-enter, edebug-before, edebug-after
|
|
|
|
|
;; and edebug-debugger.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(let ((edebug-active t) ; for minor mode alist
|
|
|
|
|
edebug-stop ; should we enter recursive-edit
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-point (+ edebug-def-mark
|
|
|
|
|
(aref (nth 2 edebug-data) edebug-offset-index)))
|
|
|
|
|
edebug-buffer-outside-point ; current point in edebug-buffer
|
|
|
|
|
;; window displaying edebug-buffer
|
|
|
|
|
(edebug-window-data (nth 3 edebug-data))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-outside-window (selected-window))
|
|
|
|
|
(edebug-outside-buffer (current-buffer))
|
|
|
|
|
(edebug-outside-point (point))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-outside-mark (edebug-mark))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
edebug-outside-windows ; window or screen configuration
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-buffer-points
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
edebug-eval-buffer ; declared here so we can kill it below
|
|
|
|
|
(edebug-eval-result-list (and edebug-eval-list
|
|
|
|
|
(edebug-eval-result-list)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-trace-window
|
|
|
|
|
edebug-trace-window-start
|
1994-04-04 21:52:06 +00:00
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
(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)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(if edebug-save-displayed-buffer-points
|
|
|
|
|
(setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
|
|
|
|
|
|
|
|
|
|
;; First move the edebug buffer point to edebug-point
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; so that window start doesn't get changed when we display it.
|
|
|
|
|
;; I don't know if this is going to help.
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;;(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)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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)
|
|
|
|
|
)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(setcdr edebug-window-data
|
|
|
|
|
(edebug-adjust-window (cdr edebug-window-data)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; 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)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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.
|
|
|
|
|
)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(if (or edebug-stop
|
|
|
|
|
(memq edebug-execution-mode '(step next))
|
|
|
|
|
(eq edebug-arg-mode 'error))
|
|
|
|
|
(progn
|
|
|
|
|
;; (setq edebug-execution-mode 'step)
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; (edebug-overlay-arrow) ; This doesn't always show up.
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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)))))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; 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
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; - otherwise quitting doesn't leave point as is.
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; 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.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Needed even if restoring windows because
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; that doesn't restore point and mark in the current buffer.
|
|
|
|
|
;; But don't restore point if edebug-buffer is current buffer.
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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.
|
|
|
|
|
)
|
|
|
|
|
;; 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)
|
|
|
|
|
)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defvar edebug-number-of-recursions 0)
|
|
|
|
|
;; Number of recursive edits started by edebug.
|
|
|
|
|
;; Should be 0 at the top level.
|
|
|
|
|
|
|
|
|
|
(defvar edebug-recursion-depth 0)
|
|
|
|
|
;; Value of recursion-depth when edebug was called.
|
|
|
|
|
|
|
|
|
|
;; 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-interactive-p)
|
|
|
|
|
|
|
|
|
|
(defvar edebug-outside-map)
|
|
|
|
|
(defvar edebug-outside-standard-output)
|
|
|
|
|
(defvar edebug-outside-standard-input)
|
|
|
|
|
(defvar edebug-outside-last-command-char)
|
|
|
|
|
(defvar edebug-outside-last-command)
|
|
|
|
|
(defvar edebug-outside-this-command)
|
|
|
|
|
(defvar edebug-outside-last-input-char)
|
|
|
|
|
|
1994-04-05 01:21:06 +00:00
|
|
|
|
;; 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.
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Emacs 18
|
|
|
|
|
(defvar edebug-outside-unread-command-char)
|
|
|
|
|
|
|
|
|
|
;; Lucid Emacs
|
|
|
|
|
(defvar edebug-outside-unread-command-event) ;; like unread-command-events
|
|
|
|
|
(defvar unread-command-event nil)
|
|
|
|
|
|
|
|
|
|
;; Emacs 19.
|
|
|
|
|
(defvar edebug-outside-last-command-event)
|
|
|
|
|
(defvar edebug-outside-unread-command-events)
|
|
|
|
|
(defvar edebug-outside-last-input-event)
|
|
|
|
|
(defvar edebug-outside-last-event-frame)
|
|
|
|
|
(defvar edebug-outside-last-nonmenu-event)
|
|
|
|
|
(defvar edebug-outside-track-mouse)
|
|
|
|
|
|
|
|
|
|
;; 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)
|
|
|
|
|
(defvar edebug-unread-command-event-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))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-recursive-edit ()
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Start up a recursive edit inside of edebug.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
;; The current buffer is the edebug-buffer, which is put into edebug-mode.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Assume that none of the variables below are buffer-local.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(let ((edebug-buffer-read-only buffer-read-only)
|
|
|
|
|
;; match-data must be done in the outside buffer
|
|
|
|
|
(edebug-outside-match-data
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(save-excursion ; might be unnecessary now??
|
|
|
|
|
(set-buffer edebug-outside-buffer) ; in case match buffer different
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(match-data)))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;;(edebug-number-of-recursions (1+ edebug-number-of-recursions))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-recursion-depth (recursion-depth))
|
|
|
|
|
edebug-entered ; bind locally to nil
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-interactive-p nil) ; again non-interactive
|
1992-05-30 23:52:26 +00:00
|
|
|
|
edebug-backtrace-buffer ; each recursive edit gets its own
|
|
|
|
|
;; The window configuration may be saved and restored
|
|
|
|
|
;; during a recursive-edit
|
|
|
|
|
edebug-inside-windows
|
|
|
|
|
|
|
|
|
|
(edebug-outside-map (current-local-map))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-outside-standard-output standard-output)
|
|
|
|
|
(edebug-outside-standard-input standard-input)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(edebug-outside-defining-kbd-macro defining-kbd-macro)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(edebug-outside-last-command-char last-command-char)
|
|
|
|
|
(edebug-outside-last-command last-command)
|
|
|
|
|
(edebug-outside-this-command this-command)
|
|
|
|
|
(edebug-outside-last-input-char last-input-char)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(edebug-outside-unread-command-char unread-command-char)
|
|
|
|
|
|
|
|
|
|
(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)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
(unwind-protect
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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)
|
|
|
|
|
|
|
|
|
|
;; 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)
|
|
|
|
|
|
|
|
|
|
;; 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)
|
1996-09-24 06:54:18 +00:00
|
|
|
|
(setq signal-hook-function nil)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
|
|
|
|
|
(edebug-mode)
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(recursive-edit) ; <<<<<<<<<< Recursive edit
|
|
|
|
|
|
|
|
|
|
;; Do the following, even if quit occurs.
|
1996-09-24 06:54:18 +00:00
|
|
|
|
(setq signal-hook-function 'edebug-signal)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(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 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-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
|
|
|
|
|
|
|
|
|
|
standard-output edebug-outside-standard-output
|
|
|
|
|
standard-input edebug-outside-standard-input
|
|
|
|
|
defining-kbd-macro edebug-outside-defining-kbd-macro
|
|
|
|
|
))
|
|
|
|
|
))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;;; Display related functions
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-adjust-window (old-start)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; If pos is not visible, adjust current window to fit following context.
|
|
|
|
|
;;; (message "window: %s old-start: %s window-start: %s pos: %s"
|
|
|
|
|
;;; (selected-window) old-start (window-start) (point)) (sit-for 5)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(if (not (pos-visible-in-window-p))
|
|
|
|
|
(progn
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; First try old-start
|
|
|
|
|
(if old-start
|
|
|
|
|
(set-window-start (selected-window) old-start))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(if (not (pos-visible-in-window-p))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(progn
|
|
|
|
|
;; (message "resetting window start") (sit-for 2)
|
|
|
|
|
(set-window-start
|
|
|
|
|
(selected-window)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(forward-line
|
|
|
|
|
(if (< (point) (window-start)) -1 ; one line before if in back
|
|
|
|
|
(- (/ (window-height) 2)) ; center the line moving forward
|
|
|
|
|
))
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(point)))))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(window-start))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defconst edebug-arrow-alist
|
|
|
|
|
'((Continue-fast . "=")
|
|
|
|
|
(Trace-fast . "-")
|
|
|
|
|
(continue . ">")
|
|
|
|
|
(trace . "->")
|
|
|
|
|
(step . "=>")
|
|
|
|
|
(next . "=>")
|
|
|
|
|
(go . "<>")
|
|
|
|
|
(Go-nonstop . "..") ; not used
|
|
|
|
|
)
|
|
|
|
|
"Association list of arrows for each edebug mode.")
|
|
|
|
|
|
|
|
|
|
(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
|
|
|
|
|
;; edebug-execution-mode.
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(let ((pos (save-excursion (beginning-of-line) (point))))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq overlay-arrow-string
|
|
|
|
|
(cdr (assq edebug-execution-mode edebug-arrow-alist)))
|
|
|
|
|
(setq overlay-arrow-position (make-marker))
|
|
|
|
|
(set-marker overlay-arrow-position pos (current-buffer))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-toggle-save-all-windows ()
|
|
|
|
|
"Toggle the saving and restoring of all windows.
|
|
|
|
|
Also, each time you toggle it on, the inside and outside window
|
|
|
|
|
configurations become the same as the current configuration."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq edebug-save-windows (not edebug-save-windows))
|
|
|
|
|
(if edebug-save-windows
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(setq edebug-inside-windows
|
|
|
|
|
(setq edebug-outside-windows
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-current-windows
|
|
|
|
|
edebug-save-windows))))
|
|
|
|
|
(message "Window saving is %s for all windows."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(if edebug-save-windows "on" "off")))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-toggle-save-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)
|
|
|
|
|
(cond
|
|
|
|
|
((eq t edebug-save-windows)
|
|
|
|
|
;; Save all outside windows except the selected one.
|
|
|
|
|
;; Remove (selected-window) from outside-windows.
|
|
|
|
|
(edebug-changing-windows
|
|
|
|
|
(setq edebug-save-windows (delq window (edebug-window-list)))))
|
|
|
|
|
|
|
|
|
|
((memq (selected-window) edebug-save-windows)
|
|
|
|
|
(setq edebug-outside-windows
|
|
|
|
|
(delq (assq (selected-window) edebug-outside-windows)
|
|
|
|
|
edebug-outside-windows))
|
|
|
|
|
(setq edebug-save-windows
|
|
|
|
|
(delq (selected-window) edebug-save-windows)))
|
|
|
|
|
(t ; Save a new window.
|
|
|
|
|
(edebug-changing-windows
|
|
|
|
|
(setq edebug-save-windows (cons window edebug-save-windows)))))
|
|
|
|
|
|
|
|
|
|
(message "Window saving is %s for %s."
|
|
|
|
|
(if (memq (selected-window) edebug-save-windows)
|
|
|
|
|
"on" "off")
|
|
|
|
|
(selected-window)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-toggle-save-windows (arg)
|
|
|
|
|
"Toggle the saving and restoring of windows.
|
|
|
|
|
With prefix, toggle for just the selected window.
|
|
|
|
|
Otherwise, toggle for all windows."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(if arg
|
|
|
|
|
(edebug-toggle-save-selected-window)
|
|
|
|
|
(edebug-toggle-save-all-windows)))
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-where ()
|
|
|
|
|
"Show the debug windows and where we stopped in the program."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (not edebug-active)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(error "Edebug is not active"))
|
|
|
|
|
;; Restore the window configuration to what it last was inside.
|
|
|
|
|
;; But it is not always set. - experiment
|
|
|
|
|
;;(if edebug-inside-windows
|
|
|
|
|
;; (edebug-set-windows edebug-inside-windows))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-pop-to-buffer edebug-buffer)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(goto-char edebug-point))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-view-outside ()
|
|
|
|
|
"Change to the outside window configuration."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (not edebug-active)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(error "Edebug is not active"))
|
|
|
|
|
(setq edebug-inside-windows
|
|
|
|
|
(edebug-current-windows edebug-save-windows))
|
|
|
|
|
(edebug-set-windows edebug-outside-windows)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(goto-char edebug-outside-point)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(message "Window configuration outside of Edebug. Return with %s"
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(substitute-command-keys "\\<global-map>\\[edebug-where]")))
|
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-bounce-point (arg)
|
|
|
|
|
"Bounce the point in the outside current buffer.
|
|
|
|
|
If prefix arg is supplied, sit for that many seconds before returning.
|
|
|
|
|
The default is one second."
|
|
|
|
|
(interactive "p")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(if (not edebug-active)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(error "Edebug is not active"))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(save-excursion
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; If the buffer's currently displayed, avoid set-window-configuration.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(save-window-excursion
|
|
|
|
|
(edebug-pop-to-buffer edebug-outside-buffer)
|
|
|
|
|
(goto-char edebug-outside-point)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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)))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
'(defvar edebug-display-buffer-list nil
|
|
|
|
|
"List of buffers that edebug will display when it is active.")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
'(defun edebug-display-buffer (buffer)
|
|
|
|
|
"Toggle display of a buffer inside of edebug."
|
|
|
|
|
(interactive "bBuffer: ")
|
|
|
|
|
(let ((already-displaying (memq buffer edebug-display-buffer-list)))
|
|
|
|
|
(setq edebug-display-buffer-list
|
|
|
|
|
(if already-displaying
|
|
|
|
|
(delq buffer edebug-display-buffer-list)
|
|
|
|
|
(cons buffer edebug-display-buffer-list)))
|
|
|
|
|
(message "Displaying %s %s" buffer
|
|
|
|
|
(if already-displaying "off" "on"))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;;; Breakpoint related functions
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-find-stop-point ()
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Return (function . index) of the nearest edebug stop point.
|
|
|
|
|
(let* ((edebug-def-name (edebug-form-data-symbol))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-data
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(let ((data (get edebug-def-name 'edebug)))
|
|
|
|
|
(if (or (null data) (markerp data))
|
|
|
|
|
(error "%s is not instrumented for Edebug" edebug-def-name))
|
|
|
|
|
data)) ; we could do it automatically, if data is a marker.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
;; pull out parts of edebug-data.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-def-mark (car edebug-data))
|
|
|
|
|
;; (edebug-breakpoints (car (cdr edebug-data)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(offset-vector (nth 2 edebug-data))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(offset (- (save-excursion
|
|
|
|
|
(if (looking-at "[ \t]")
|
|
|
|
|
;; skip backwards until non-whitespace, or bol
|
|
|
|
|
(skip-chars-backward " \t"))
|
|
|
|
|
(point))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-def-mark))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
len i)
|
|
|
|
|
;; the offsets are in order so we can do a linear search
|
|
|
|
|
(setq len (length offset-vector))
|
|
|
|
|
(setq i 0)
|
|
|
|
|
(while (and (< i len) (> offset (aref offset-vector i)))
|
|
|
|
|
(setq i (1+ i)))
|
|
|
|
|
(if (and (< i len)
|
|
|
|
|
(<= offset (aref offset-vector i)))
|
|
|
|
|
;; return the relevant info
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(cons edebug-def-name i)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(message "Point is not on an expression in %s."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-def-name)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-next-breakpoint ()
|
|
|
|
|
"Move point to the next breakpoint, or first if none past point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((edebug-stop-point (edebug-find-stop-point)))
|
|
|
|
|
(if edebug-stop-point
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(let* ((edebug-def-name (car edebug-stop-point))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(index (cdr edebug-stop-point))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-data (get edebug-def-name 'edebug))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
;; pull out parts of edebug-data
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-def-mark (car edebug-data))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-breakpoints (car (cdr edebug-data)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(offset-vector (nth 2 edebug-data))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
breakpoint)
|
|
|
|
|
(if (not edebug-breakpoints)
|
|
|
|
|
(message "No breakpoints in this function.")
|
|
|
|
|
(let ((breaks edebug-breakpoints))
|
|
|
|
|
(while (and breaks
|
|
|
|
|
(<= (car (car breaks)) index))
|
|
|
|
|
(setq breaks (cdr breaks)))
|
|
|
|
|
(setq breakpoint
|
|
|
|
|
(if breaks
|
|
|
|
|
(car breaks)
|
|
|
|
|
;; goto the first breakpoint
|
|
|
|
|
(car edebug-breakpoints)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(goto-char (+ edebug-def-mark
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(aref offset-vector (car breakpoint))))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(message "%s"
|
|
|
|
|
(concat (if (nth 2 breakpoint)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"Temporary " "")
|
|
|
|
|
(if (car (cdr breakpoint))
|
|
|
|
|
(format "Condition: %s"
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-safe-prin1-to-string
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(car (cdr breakpoint))))
|
|
|
|
|
"")))
|
|
|
|
|
))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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.
|
|
|
|
|
If CONDITION or TEMPORARY are non-nil, add those attributes to
|
|
|
|
|
the breakpoint. "
|
|
|
|
|
(let ((edebug-stop-point (edebug-find-stop-point)))
|
|
|
|
|
(if edebug-stop-point
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(let* ((edebug-def-name (car edebug-stop-point))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(index (cdr edebug-stop-point))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-data (get edebug-def-name 'edebug))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
;; pull out parts of edebug-data
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-def-mark (car edebug-data))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-breakpoints (car (cdr edebug-data)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(offset-vector (nth 2 edebug-data))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
present)
|
|
|
|
|
;; delete it either way
|
|
|
|
|
(setq present (assq index edebug-breakpoints))
|
|
|
|
|
(setq edebug-breakpoints (delq present edebug-breakpoints))
|
|
|
|
|
(if flag
|
|
|
|
|
(progn
|
|
|
|
|
;; add it to the list and resort
|
|
|
|
|
(setq edebug-breakpoints
|
|
|
|
|
(edebug-sort-alist
|
|
|
|
|
(cons
|
|
|
|
|
(list index condition temporary)
|
|
|
|
|
edebug-breakpoints) '<))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if condition
|
|
|
|
|
(message "Breakpoint set in %s with condition: %s"
|
|
|
|
|
edebug-def-name condition)
|
|
|
|
|
(message "Breakpoint set in %s" edebug-def-name)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(if present
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(message "Breakpoint unset in %s" edebug-def-name)
|
|
|
|
|
(message "No breakpoint here")))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setcar (cdr edebug-data) edebug-breakpoints)
|
|
|
|
|
(goto-char (+ edebug-def-mark (aref offset-vector index)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-set-breakpoint (arg)
|
|
|
|
|
"Set the breakpoint of nearest sexp.
|
|
|
|
|
With prefix argument, make it a temporary breakpoint."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(edebug-modify-breakpoint t nil arg))
|
|
|
|
|
|
|
|
|
|
(defun edebug-unset-breakpoint ()
|
|
|
|
|
"Clear the breakpoint of nearest sexp."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-modify-breakpoint nil))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; For emacs 18, no read-expression-history
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(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."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; (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 ""))))))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-modify-breakpoint t condition arg))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-set-global-break-condition (expression)
|
|
|
|
|
(interactive (list (read-minibuffer
|
|
|
|
|
"Global Condition: "
|
|
|
|
|
(format "%s" edebug-global-break-condition))))
|
|
|
|
|
(setq edebug-global-break-condition expression))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Mode switching functions
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-set-mode (mode shortmsg msg)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Set the edebug mode to MODE.
|
|
|
|
|
;; Display SHORTMSG, or MSG if not within edebug.
|
|
|
|
|
(if (eq (1+ edebug-recursion-depth) (recursion-depth))
|
|
|
|
|
(progn
|
|
|
|
|
(setq edebug-execution-mode mode)
|
|
|
|
|
(message shortmsg)
|
|
|
|
|
;; Continue execution
|
|
|
|
|
(exit-recursive-edit))
|
|
|
|
|
;; This is not terribly useful!!
|
|
|
|
|
(setq edebug-next-execution-mode mode)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(message msg)))
|
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defalias 'edebug-step-through-mode 'edebug-step-mode)
|
|
|
|
|
|
|
|
|
|
(defun edebug-step-mode ()
|
|
|
|
|
"Proceed to next stop point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-set-mode 'step "" "Edebug will stop at next stop point."))
|
|
|
|
|
|
|
|
|
|
(defun edebug-next-mode ()
|
|
|
|
|
"Proceed to next `after' stop point."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-set-mode 'next "" "Edebug will stop after next eval."))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-go-mode (arg)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"Go, evaluating until break.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
With prefix ARG, set temporary break at current point and go."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(if arg
|
|
|
|
|
(edebug-set-breakpoint t))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-set-mode 'go "Go..." "Edebug will go until break."))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-Go-nonstop-mode ()
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"Go, evaluating without debugging."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-set-mode 'Go-nonstop "Go-Nonstop..."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
"Edebug will not stop at breaks."))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-trace-mode ()
|
|
|
|
|
"Begin trace mode."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-set-mode 'trace "Tracing..." "Edebug will trace with pause."))
|
|
|
|
|
|
|
|
|
|
(defun edebug-Trace-fast-mode ()
|
|
|
|
|
"Trace with no wait at each step."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-set-mode 'Trace-fast
|
|
|
|
|
"Trace fast..." "Edebug will trace without pause."))
|
|
|
|
|
|
|
|
|
|
(defun edebug-continue-mode ()
|
|
|
|
|
"Begin continue mode."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-set-mode 'continue "Continue..."
|
|
|
|
|
"Edebug will pause at breakpoints."))
|
|
|
|
|
|
|
|
|
|
(defun edebug-Continue-fast-mode ()
|
|
|
|
|
"Trace with no wait at each step."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-set-mode 'Continue-fast "Continue fast..."
|
|
|
|
|
"Edebug will stop and go at breakpoints."))
|
|
|
|
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
|
|
|
;; The following use the mode changing commands and breakpoints.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-goto-here ()
|
|
|
|
|
"Proceed to this stop point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-go-mode t))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-stop ()
|
|
|
|
|
"Stop execution and do not continue.
|
|
|
|
|
Useful for exiting from trace or continue loop."
|
|
|
|
|
(interactive)
|
|
|
|
|
(message "Stop"))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
'(defun edebug-forward ()
|
|
|
|
|
"Proceed to the exit of the next expression to be evaluated."
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-set-mode
|
|
|
|
|
'forward "Forward"
|
|
|
|
|
"Edebug will stop after exiting the next expression."))
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-forward-sexp (arg)
|
|
|
|
|
"Proceed from the current point to the end of the ARGth sexp ahead.
|
|
|
|
|
If there are not ARG sexps ahead, then do edebug-step-out."
|
|
|
|
|
(interactive "p")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(condition-case nil
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(let ((parse-sexp-ignore-comments t))
|
|
|
|
|
;; Call forward-sexp repeatedly until done or failure.
|
|
|
|
|
(forward-sexp arg)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-go-mode t))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(error
|
|
|
|
|
(edebug-step-out)
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-step-out ()
|
|
|
|
|
"Proceed from the current point to the end of the containing sexp.
|
|
|
|
|
If there is no containing sexp that is not the top level defun,
|
|
|
|
|
go to the end of the last sexp, or if that is the same point, then step."
|
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(condition-case nil
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(let ((parse-sexp-ignore-comments t))
|
|
|
|
|
(up-list 1)
|
|
|
|
|
(save-excursion
|
|
|
|
|
;; Is there still a containing expression?
|
|
|
|
|
(up-list 1))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-go-mode t))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(error
|
|
|
|
|
;; At top level - 1, so first check if there are more sexps at this level.
|
|
|
|
|
(let ((start-point (point)))
|
|
|
|
|
;; (up-list 1)
|
|
|
|
|
(down-list -1)
|
|
|
|
|
(if (= (point) start-point)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-step-mode) ; No more at this level, so step.
|
|
|
|
|
(edebug-go-mode t)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
)))))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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))
|
|
|
|
|
(cond
|
|
|
|
|
((markerp func-marker)
|
|
|
|
|
;; It is uninstrumented, so instrument it.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-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))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-instrument-callee ()
|
|
|
|
|
"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."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if (not (looking-at "\("))
|
|
|
|
|
(error "You must be before a list form")
|
|
|
|
|
(let ((func
|
|
|
|
|
(save-excursion
|
|
|
|
|
(down-list 1)
|
|
|
|
|
(if (looking-at "\(")
|
|
|
|
|
(edebug-form-data-name
|
|
|
|
|
(edebug-get-form-data-entry (point)))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(edebug-original-read (current-buffer))))))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-instrument-function func))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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
|
|
|
|
|
instrumented. Then it does `edebug-on-entry' and switches to `go' mode."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(let ((func (edebug-instrument-callee)))
|
|
|
|
|
(if func
|
|
|
|
|
(progn
|
|
|
|
|
(edebug-on-entry func 'temp)
|
|
|
|
|
(edebug-go-mode nil)))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-on-entry (function &optional flag)
|
|
|
|
|
"Cause Edebug to stop when FUNCTION is called.
|
|
|
|
|
With prefix argument, make this temporary so it is automatically
|
|
|
|
|
cancelled the first time the function is entered."
|
|
|
|
|
(interactive "aEdebug on entry to: \nP")
|
|
|
|
|
;; Could store this in the edebug data instead.
|
|
|
|
|
(put function 'edebug-on-entry (if flag 'temp t)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun cancel-edebug-on-entry (function)
|
|
|
|
|
(interactive "aEdebug on entry to: ")
|
|
|
|
|
(put function 'edebug-on-entry nil))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(if (not (fboundp 'edebug-original-debug-on-entry))
|
|
|
|
|
(fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
'(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this?
|
|
|
|
|
;; Also need edebug-cancel-debug-on-entry
|
|
|
|
|
|
|
|
|
|
'(defun edebug-debug-on-entry (function)
|
|
|
|
|
"Request FUNCTION to invoke debugger each time it is called.
|
|
|
|
|
If the user continues, FUNCTION's execution proceeds.
|
|
|
|
|
Works by modifying the definition of FUNCTION,
|
|
|
|
|
which must be written in Lisp, not predefined.
|
|
|
|
|
Use `cancel-debug-on-entry' to cancel the effect of this command.
|
|
|
|
|
Redefining FUNCTION also does that.
|
|
|
|
|
|
|
|
|
|
This version is from Edebug. If the function is instrumented for
|
|
|
|
|
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))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(edebug-original-debug-on-entry function)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-on-entry function))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-top-level-nonstop ()
|
|
|
|
|
"Set mode to Go-nonstop, and exit to top-level.
|
|
|
|
|
This is useful for exiting even if unwind-protect code may be executed."
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq edebug-execution-mode 'Go-nonstop)
|
|
|
|
|
(top-level))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;(defun edebug-exit-out ()
|
|
|
|
|
;; "Go until the current function exits."
|
|
|
|
|
;; (interactive)
|
|
|
|
|
;; (edebug-set-mode 'exiting "Exit..."))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; The following initial mode setting definitions are not used yet.
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
'(defconst edebug-initial-mode-alist
|
1992-05-30 23:52:26 +00:00
|
|
|
|
'((edebug-Continue-fast . Continue-fast)
|
|
|
|
|
(edebug-Trace-fast . Trace-fast)
|
|
|
|
|
(edebug-continue . continue)
|
|
|
|
|
(edebug-trace . trace)
|
|
|
|
|
(edebug-go . go)
|
|
|
|
|
(edebug-step-through . step)
|
|
|
|
|
(edebug-Go-nonstop . Go-nonstop)
|
|
|
|
|
)
|
|
|
|
|
"Association list between commands and the modes they set.")
|
|
|
|
|
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
'(defun edebug-set-initial-mode ()
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"Ask for the initial mode of the enclosing function.
|
|
|
|
|
The mode is requested via the key that would be used to set the mode in
|
|
|
|
|
edebug-mode."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((this-function (edebug-which-function))
|
|
|
|
|
(keymap (if (eq edebug-mode-map (current-local-map))
|
|
|
|
|
edebug-mode-map))
|
|
|
|
|
(old-mode (or (get this-function 'edebug-initial-mode)
|
|
|
|
|
edebug-initial-mode))
|
|
|
|
|
(key (read-key-sequence
|
|
|
|
|
(format
|
|
|
|
|
"Change initial edebug mode for %s from %s (%s) to (enter key): "
|
|
|
|
|
this-function
|
|
|
|
|
old-mode
|
|
|
|
|
(where-is-internal
|
|
|
|
|
(car (rassq old-mode edebug-initial-mode-alist))
|
|
|
|
|
keymap 'firstonly
|
|
|
|
|
))))
|
|
|
|
|
(mode (cdr (assq (key-binding key) edebug-initial-mode-alist)))
|
|
|
|
|
)
|
|
|
|
|
(if (and mode
|
|
|
|
|
(or (get this-function 'edebug-initial-mode)
|
|
|
|
|
(not (eq mode edebug-initial-mode))))
|
|
|
|
|
(progn
|
|
|
|
|
(put this-function 'edebug-initial-mode mode)
|
|
|
|
|
(message "Initial mode for %s is now: %s"
|
|
|
|
|
this-function mode))
|
1993-11-23 08:43:48 +00:00
|
|
|
|
(error "Key must map to one of the mode changing commands")
|
1992-05-30 23:52:26 +00:00
|
|
|
|
)))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;;; Evaluation of expressions
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(def-edebug-spec edebug-outside-excursion t)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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)
|
|
|
|
|
(standard-output edebug-outside-standard-output)
|
|
|
|
|
(standard-input edebug-outside-standard-input)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
|
1996-05-29 17:17:34 +00:00
|
|
|
|
(executing-kbd-macro edebug-outside-executing-macro)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defining-kbd-macro edebug-outside-defining-kbd-macro)
|
1994-04-04 21:52:06 +00:00
|
|
|
|
(pre-command-hook edebug-outside-pre-command-hook)
|
|
|
|
|
(post-command-hook 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)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
)
|
|
|
|
|
(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))
|
1994-04-04 21:52:06 +00:00
|
|
|
|
|
|
|
|
|
;; 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-event unread-command-event
|
|
|
|
|
edebug-outside-unread-command-events unread-command-events
|
|
|
|
|
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
|
|
|
|
|
|
1996-05-29 17:17:34 +00:00
|
|
|
|
edebug-outside-executing-macro executing-kbd-macro
|
1994-04-04 21:52:06 +00:00
|
|
|
|
edebug-outside-defining-kbd-macro defining-kbd-macro
|
|
|
|
|
edebug-outside-pre-command-hook pre-command-hook
|
|
|
|
|
edebug-outside-post-command-hook post-command-hook
|
|
|
|
|
|
|
|
|
|
edebug-outside-o-a-p overlay-arrow-position
|
|
|
|
|
edebug-outside-o-a-s overlay-arrow-string
|
|
|
|
|
edebug-outside-c-i-e-a cursor-in-echo-area
|
|
|
|
|
))) ; let
|
1994-03-24 20:38:34 +00:00
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
(defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
|
|
|
|
|
|
|
|
|
|
(defun edebug-eval (edebug-expr)
|
|
|
|
|
;; Are there cl lexical variables active?
|
|
|
|
|
(if cl-debug-env
|
|
|
|
|
(eval (cl-macroexpand-all edebug-expr cl-debug-env))
|
|
|
|
|
(eval edebug-expr)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-safe-eval (edebug-expr)
|
|
|
|
|
;; 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
|
|
|
|
|
(get (car edebug-err) 'error-message)
|
|
|
|
|
(car (cdr edebug-err))))))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Printing
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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)
|
|
|
|
|
|
|
|
|
|
(defun edebug-install-custom-print ()
|
|
|
|
|
"Replace print functions used by Edebug with custom versions."
|
|
|
|
|
;; Modifying the custom print functions, or changing print-length,
|
|
|
|
|
;; print-level, print-circle, custom-print-list or custom-print-vector
|
|
|
|
|
;; have immediate effect.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(require 'cust-print)
|
|
|
|
|
(defalias 'edebug-prin1 'custom-prin1)
|
|
|
|
|
(defalias 'edebug-print 'custom-print)
|
|
|
|
|
(defalias 'edebug-prin1-to-string 'custom-prin1-to-string)
|
|
|
|
|
(defalias 'edebug-format 'custom-format)
|
|
|
|
|
(defalias 'edebug-message 'custom-message)
|
|
|
|
|
"Installed")
|
|
|
|
|
|
|
|
|
|
(eval-and-compile
|
|
|
|
|
(defun edebug-uninstall-custom-print ()
|
|
|
|
|
"Replace edebug custom print functions with internal versions."
|
|
|
|
|
(interactive)
|
|
|
|
|
(defalias 'edebug-prin1 'prin1)
|
|
|
|
|
(defalias 'edebug-print 'print)
|
|
|
|
|
(defalias 'edebug-prin1-to-string 'prin1-to-string)
|
|
|
|
|
(defalias 'edebug-format 'format)
|
|
|
|
|
(defalias 'edebug-message 'message)
|
|
|
|
|
"Uninstalled")
|
|
|
|
|
|
|
|
|
|
;; Default print functions are the same as Emacs'.
|
|
|
|
|
(edebug-uninstall-custom-print))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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"
|
|
|
|
|
(or (get (car edebug-value) 'error-message)
|
|
|
|
|
(format "peculiar error (%s)" (car edebug-value)))
|
|
|
|
|
(mapconcat (function (lambda (edebug-arg)
|
|
|
|
|
;; continuing after an error may
|
|
|
|
|
;; complain about edebug-arg. why??
|
|
|
|
|
(prin1-to-string edebug-arg)))
|
|
|
|
|
(cdr edebug-value) ", ")))
|
|
|
|
|
|
|
|
|
|
;; Define here in case they are not already defined.
|
|
|
|
|
(defvar print-level nil)
|
|
|
|
|
(defvar print-circle nil)
|
|
|
|
|
(defvar print-readably) ;; defined by lemacs
|
|
|
|
|
;; Alternatively, we could change the definition of
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; edebug-safe-prin1-to-string to only use these if defined.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-safe-prin1-to-string (value)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(let ((print-escape-newlines t)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(print-length (or edebug-print-length print-length))
|
|
|
|
|
(print-level (or edebug-print-level print-level))
|
|
|
|
|
(print-circle (or edebug-print-circle print-circle))
|
|
|
|
|
(print-readably nil)) ;; lemacs uses this.
|
|
|
|
|
(edebug-prin1-to-string value)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-compute-previous-result (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)))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-previous-result ()
|
|
|
|
|
"Print the previous result."
|
|
|
|
|
(interactive)
|
|
|
|
|
(message "%s" edebug-previous-result))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Read, Eval and Print
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug-eval-expression (edebug-expr)
|
|
|
|
|
"Evaluate an expression in the outside environment.
|
|
|
|
|
If interactive, prompt for the expression.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
Print result in minibuffer."
|
|
|
|
|
(interactive "xEval: ")
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(princ
|
|
|
|
|
(edebug-outside-excursion
|
|
|
|
|
(setq values (cons (edebug-eval edebug-expr) values))
|
|
|
|
|
(edebug-safe-prin1-to-string (car values)))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-eval-last-sexp ()
|
|
|
|
|
"Evaluate sexp before point in the outside environment;
|
|
|
|
|
print value in minibuffer."
|
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-eval-expression (edebug-last-sexp)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-eval-print-last-sexp ()
|
|
|
|
|
"Evaluate sexp before point in the outside environment;
|
|
|
|
|
print value into current buffer."
|
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(let* ((edebug-form (edebug-last-sexp))
|
|
|
|
|
(edebug-result-string
|
|
|
|
|
(edebug-outside-excursion
|
|
|
|
|
(edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
|
|
|
|
|
(standard-output (current-buffer)))
|
|
|
|
|
(princ "\n")
|
|
|
|
|
;; princ the string to get rid of quotes.
|
|
|
|
|
(princ edebug-result-string)
|
|
|
|
|
(princ "\n")
|
|
|
|
|
))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Edebug Minor Mode
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; 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)
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defvar edebug-mode-map nil)
|
|
|
|
|
(if edebug-mode-map
|
|
|
|
|
nil
|
|
|
|
|
(progn
|
|
|
|
|
(setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
|
|
|
|
|
;; control
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key edebug-mode-map "f" 'edebug-forward-sexp)
|
|
|
|
|
(define-key edebug-mode-map "h" 'edebug-goto-here)
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key edebug-mode-map "I" 'edebug-instrument-callee)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key edebug-mode-map "i" 'edebug-step-in)
|
|
|
|
|
(define-key edebug-mode-map "o" 'edebug-step-out)
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; quitting and stopping
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key edebug-mode-map "q" 'top-level)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key edebug-mode-map "a" 'abort-recursive-edit)
|
|
|
|
|
(define-key edebug-mode-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)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
;; evaluation
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key edebug-mode-map "r" 'edebug-previous-result)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(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)
|
|
|
|
|
|
|
|
|
|
;; views
|
|
|
|
|
(define-key edebug-mode-map "w" 'edebug-where)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key edebug-mode-map "v" 'edebug-view-outside) ;; maybe obsolete??
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key edebug-mode-map "p" 'edebug-bounce-point)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key edebug-mode-map "W" 'edebug-toggle-save-windows)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
;; misc
|
|
|
|
|
(define-key edebug-mode-map "?" 'edebug-help)
|
|
|
|
|
(define-key edebug-mode-map "d" 'edebug-backtrace)
|
|
|
|
|
|
|
|
|
|
(define-key edebug-mode-map "-" 'negative-argument)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;; statistics
|
|
|
|
|
(define-key edebug-mode-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)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Autoloading these global bindings doesn't make sense because
|
|
|
|
|
;; they cannot be used anyway unless Edebug is already loaded and active.
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(defvar global-edebug-prefix "\^XX"
|
|
|
|
|
"Prefix key for global edebug commands, available from any buffer.")
|
|
|
|
|
|
|
|
|
|
(defvar global-edebug-map nil
|
|
|
|
|
"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)
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(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
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key global-edebug-map "b" 'edebug-set-breakpoint)
|
|
|
|
|
(define-key global-edebug-map "u" 'edebug-unset-breakpoint)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)
|
|
|
|
|
(define-key global-edebug-map "X" 'edebug-set-global-break-condition)
|
|
|
|
|
|
|
|
|
|
;; views
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key global-edebug-map "w" 'edebug-where)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key global-edebug-map "W" 'edebug-toggle-save-windows)
|
|
|
|
|
|
|
|
|
|
;; quitting
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(define-key global-edebug-map "q" 'top-level)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(define-key global-edebug-map "Q" 'edebug-top-level-nonstop)
|
|
|
|
|
(define-key global-edebug-map "a" 'abort-recursive-edit)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; statistics
|
|
|
|
|
(define-key global-edebug-map "=" 'edebug-display-freq-count)
|
|
|
|
|
)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-help ()
|
|
|
|
|
(interactive)
|
|
|
|
|
(describe-function 'edebug-mode))
|
|
|
|
|
|
|
|
|
|
(defun edebug-mode ()
|
1994-03-24 20:38:34 +00:00
|
|
|
|
"Mode for Emacs Lisp buffers while in Edebug.
|
|
|
|
|
|
|
|
|
|
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]
|
|
|
|
|
in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
Also see bindings for the eval list buffer, *edebug*.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
The edebug buffer commands:
|
1992-05-30 23:52:26 +00:00
|
|
|
|
\\{edebug-mode-map}
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
Global commands prefixed by `global-edebug-prefix':
|
1992-05-30 23:52:26 +00:00
|
|
|
|
\\{global-edebug-map}
|
|
|
|
|
|
|
|
|
|
Options:
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-setup-hook
|
|
|
|
|
edebug-all-defs
|
|
|
|
|
edebug-all-forms
|
1992-05-30 23:52:26 +00:00
|
|
|
|
edebug-save-windows
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-save-displayed-buffer-points
|
1992-05-30 23:52:26 +00:00
|
|
|
|
edebug-initial-mode
|
|
|
|
|
edebug-trace
|
1994-03-24 20:38:34 +00:00
|
|
|
|
edebug-test-coverage
|
|
|
|
|
edebug-continue-kbd-macro
|
|
|
|
|
edebug-print-length
|
|
|
|
|
edebug-print-level
|
|
|
|
|
edebug-print-circle
|
|
|
|
|
edebug-on-error
|
|
|
|
|
edebug-on-quit
|
|
|
|
|
edebug-on-signal
|
|
|
|
|
edebug-unwrap-results
|
|
|
|
|
edebug-global-break-condition
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"
|
|
|
|
|
(use-local-map edebug-mode-map))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; edebug eval list mode
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; A list of expressions and their evaluations is displayed in *edebug*.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-eval-result-list ()
|
|
|
|
|
"Return a list of evaluations of edebug-eval-list"
|
|
|
|
|
;; Assumes in outside environment.
|
1994-04-04 21:52:06 +00:00
|
|
|
|
;; Don't do any edebug things now.
|
|
|
|
|
(let ((edebug-execution-mode 'Go-nonstop)
|
|
|
|
|
(edebug-trace nil))
|
|
|
|
|
(mapcar 'edebug-safe-eval edebug-eval-list)))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-eval-display-list (edebug-eval-result-list)
|
|
|
|
|
;; Assumes edebug-eval-buffer exists.
|
|
|
|
|
(let ((edebug-eval-list-temp edebug-eval-list)
|
|
|
|
|
(standard-output edebug-eval-buffer)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-comment-line
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(format ";%s\n" (make-string (- (window-width) 2) ?-))))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(set-buffer edebug-eval-buffer)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(erase-buffer)
|
|
|
|
|
(while edebug-eval-list-temp
|
|
|
|
|
(prin1 (car edebug-eval-list-temp)) (terpri)
|
|
|
|
|
(prin1 (car edebug-eval-result-list)) (terpri)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(princ edebug-comment-line)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
|
|
|
|
|
(setq edebug-eval-result-list (cdr edebug-eval-result-list)))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-pop-to-buffer edebug-eval-buffer)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
(defun edebug-create-eval-buffer ()
|
|
|
|
|
(if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
|
|
|
|
|
(progn
|
|
|
|
|
(set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
|
|
|
|
|
(edebug-eval-mode))))
|
|
|
|
|
|
|
|
|
|
;; Should generalize this to be callable outside of edebug
|
|
|
|
|
;; with calls in user functions, e.g. (edebug-eval-display)
|
|
|
|
|
|
|
|
|
|
(defun edebug-eval-display (edebug-eval-result-list)
|
|
|
|
|
"Display expressions and evaluations in EVAL-LIST.
|
|
|
|
|
It modifies the context by popping up the eval display."
|
|
|
|
|
(if edebug-eval-result-list
|
|
|
|
|
(progn
|
|
|
|
|
(edebug-create-eval-buffer)
|
|
|
|
|
(edebug-eval-display-list edebug-eval-result-list)
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
(defun edebug-eval-redisplay ()
|
|
|
|
|
"Redisplay eval list in outside environment.
|
|
|
|
|
May only be called from within edebug-recursive-edit."
|
|
|
|
|
(edebug-create-eval-buffer)
|
|
|
|
|
(edebug-outside-excursion
|
|
|
|
|
(edebug-eval-display-list (edebug-eval-result-list))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
(defun edebug-visit-eval-list ()
|
|
|
|
|
(interactive)
|
|
|
|
|
(edebug-eval-redisplay)
|
|
|
|
|
(edebug-pop-to-buffer edebug-eval-buffer))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-update-eval-list ()
|
|
|
|
|
"Replace the evaluation list with the sexps now in the eval buffer."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((starting-point (point))
|
|
|
|
|
new-list)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
;; get the first expression
|
|
|
|
|
(edebug-skip-whitespace)
|
|
|
|
|
(if (not (eobp))
|
|
|
|
|
(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")
|
|
|
|
|
(if (and (/= ?\; (following-char))
|
|
|
|
|
(not (eobp)))
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-delete-eval-item ()
|
|
|
|
|
"Delete the item under point and redisplay."
|
|
|
|
|
;; could add arg to do repeatedly
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (re-search-backward "^;" nil 'nofail)
|
|
|
|
|
(forward-line 1))
|
|
|
|
|
(delete-region
|
|
|
|
|
(point) (progn (re-search-forward "^;" nil 'nofail)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(point)))
|
|
|
|
|
(edebug-update-eval-list))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defvar edebug-eval-mode-map nil
|
|
|
|
|
"Keymap for edebug-eval-mode. Superset of lisp-interaction-mode.")
|
|
|
|
|
|
|
|
|
|
(if edebug-eval-mode-map
|
|
|
|
|
nil
|
|
|
|
|
(setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
|
|
|
|
|
|
|
|
|
|
(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)
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-eval-mode ()
|
1994-03-24 20:38:34 +00:00
|
|
|
|
"Mode for evaluation list buffer while in Edebug.
|
|
|
|
|
|
|
|
|
|
In addition to all Interactive Emacs Lisp commands there are local and
|
|
|
|
|
global key bindings to several Edebug 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.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
Eval list buffer commands:
|
|
|
|
|
\\{edebug-eval-mode-map}
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
Global commands prefixed by global-edebug-prefix:
|
1992-05-30 23:52:26 +00:00
|
|
|
|
\\{global-edebug-map}
|
|
|
|
|
"
|
|
|
|
|
(lisp-interaction-mode)
|
|
|
|
|
(setq major-mode 'edebug-eval-mode)
|
|
|
|
|
(setq mode-name "Edebug-Eval")
|
|
|
|
|
(use-local-map edebug-eval-mode-map))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Interface with standard debugger.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; (setq debugger 'edebug) ; to use the edebug debugger
|
|
|
|
|
;; (setq debugger 'debug) ; use the standard debugger
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Note that debug and its utilities must be byte-compiled to work,
|
|
|
|
|
;; since they depend on the backtrace looking a certain way. But
|
|
|
|
|
;; edebug is not dependent on this, yet.
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(defun edebug (&optional edebug-arg-mode &rest debugger-args)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
"Replacement for debug.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
If we are running an edebugged function,
|
1992-05-30 23:52:26 +00:00
|
|
|
|
show where we last were. Otherwise call debug normally."
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; (message "entered: %s depth: %s edebug-recursion-depth: %s"
|
|
|
|
|
;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
|
|
|
|
|
(if (and edebug-entered ; anything active?
|
|
|
|
|
(eq (recursion-depth) edebug-recursion-depth))
|
|
|
|
|
(let (;; Where were we before the error occurred?
|
|
|
|
|
(edebug-offset-index (car edebug-offset-indices))
|
|
|
|
|
;; Bind variables required by edebug-display
|
|
|
|
|
(edebug-value (car debugger-args))
|
|
|
|
|
edebug-breakpoints
|
|
|
|
|
edebug-break-data
|
|
|
|
|
edebug-break-condition
|
|
|
|
|
edebug-global-break
|
|
|
|
|
(edebug-break (null edebug-arg-mode)) ;; if called explicitly
|
|
|
|
|
)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-display)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if (eq edebug-arg-mode 'error)
|
|
|
|
|
nil
|
|
|
|
|
edebug-value))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
;; Otherwise call debug normally.
|
|
|
|
|
;; Still need to remove extraneous edebug calls from stack.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(apply 'debug edebug-arg-mode debugger-args)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-backtrace ()
|
|
|
|
|
"Display a non-working backtrace. Better than nothing..."
|
|
|
|
|
(interactive)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if (or (not edebug-backtrace-buffer)
|
|
|
|
|
(null (buffer-name edebug-backtrace-buffer)))
|
|
|
|
|
(setq edebug-backtrace-buffer
|
|
|
|
|
(generate-new-buffer "*Backtrace*"))
|
|
|
|
|
;; else, could just display edebug-backtrace-buffer
|
|
|
|
|
)
|
|
|
|
|
(with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
|
|
|
|
|
(setq edebug-backtrace-buffer standard-output)
|
|
|
|
|
(let ((print-escape-newlines t)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(print-length 50)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
last-ok-point)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(backtrace)
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Clean up the backtrace.
|
|
|
|
|
;; Not quite right for current edebug scheme.
|
|
|
|
|
(set-buffer edebug-backtrace-buffer)
|
|
|
|
|
(setq truncate-lines t)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(setq last-ok-point (point))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if t (progn
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
;; Delete interspersed edebug internals.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(while (re-search-forward "^ \(?edebug" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(cond
|
|
|
|
|
((looking-at "^ \(edebug-after")
|
|
|
|
|
;; Previous lines may contain code, so just delete this line
|
|
|
|
|
(setq last-ok-point (point))
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(delete-region last-ok-point (point)))
|
|
|
|
|
|
|
|
|
|
((looking-at "^ edebug")
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(delete-region last-ok-point (point))
|
|
|
|
|
)))
|
|
|
|
|
)))))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Trace display
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-trace-display (buf-name fmt &rest args)
|
|
|
|
|
"In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
|
|
|
|
|
The buffer is created if it does not exist.
|
1994-03-24 20:38:34 +00:00
|
|
|
|
You must include newlines in FMT to break lines, but one newline is appended."
|
|
|
|
|
;; e.g.
|
|
|
|
|
;; (edebug-trace-display "*trace-point*"
|
|
|
|
|
;; "saving: point = %s window-start = %s"
|
|
|
|
|
;; (point) (window-start))
|
1996-07-24 16:36:41 +00:00
|
|
|
|
(let* ((oldbuf (current-buffer))
|
|
|
|
|
(selected-window (selected-window))
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(buffer (get-buffer-create buf-name))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
buf-window)
|
|
|
|
|
;; (message "before pop-to-buffer") (sit-for 1)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(edebug-pop-to-buffer buffer)
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(setq truncate-lines t)
|
|
|
|
|
(setq buf-window (selected-window))
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(insert (apply 'edebug-format fmt args) "\n")
|
|
|
|
|
;; Make it visible.
|
|
|
|
|
(vertical-motion (- 1 (window-height)))
|
|
|
|
|
(set-window-start buf-window (point))
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
;; (set-window-point buf-window (point))
|
|
|
|
|
;; (edebug-sit-for 0)
|
|
|
|
|
(bury-buffer buffer)
|
1996-07-24 16:36:41 +00:00
|
|
|
|
(select-window selected-window)
|
|
|
|
|
(set-buffer oldbuf))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
buf-name)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun edebug-trace (fmt &rest args)
|
|
|
|
|
"Convenience call to edebug-trace-display using edebug-trace-buffer"
|
|
|
|
|
(apply 'edebug-trace-display edebug-trace-buffer fmt args))
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Frequency count and coverage
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(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
|
|
|
|
|
each line, and you can undo all insertions with one `undo' command.
|
|
|
|
|
|
|
|
|
|
The counts are inserted starting under the `(' before an expression
|
|
|
|
|
or the `)' after an expression, or on the last char of a symbol.
|
|
|
|
|
The counts are only displayed when they differ from previous counts on
|
|
|
|
|
the same line.
|
|
|
|
|
|
|
|
|
|
If coverage is being tested, whenever all known results of an expression
|
|
|
|
|
are `eq', the char `=' will be appended after the count
|
|
|
|
|
for that expression. Note that this is always the case for an
|
|
|
|
|
expression only evaluated once.
|
|
|
|
|
|
|
|
|
|
To clear the frequency count and coverage data for a definition,
|
|
|
|
|
reinstrument it."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((function (edebug-form-data-symbol))
|
|
|
|
|
(counts (get function 'edebug-freq-count))
|
|
|
|
|
(coverages (get function 'edebug-coverage))
|
|
|
|
|
(data (get function 'edebug))
|
|
|
|
|
(def-mark (car data)) ; mark at def start
|
|
|
|
|
(edebug-points (nth 2 data))
|
|
|
|
|
(i (1- (length edebug-points)))
|
|
|
|
|
(last-index)
|
|
|
|
|
(first-index)
|
|
|
|
|
(start-of-line)
|
|
|
|
|
(start-of-count-line)
|
|
|
|
|
(last-count)
|
|
|
|
|
)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
(save-excursion
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Traverse in reverse order so offsets are correct.
|
|
|
|
|
(while (<= 0 i)
|
|
|
|
|
;; Start at last expression in line.
|
|
|
|
|
(goto-char (+ def-mark (aref edebug-points i)))
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(setq start-of-line (- (point) def-mark)
|
|
|
|
|
last-index i)
|
|
|
|
|
|
|
|
|
|
;; Find all indexes on same line.
|
|
|
|
|
(while (and (<= 0 (setq i (1- i)))
|
|
|
|
|
(<= start-of-line (aref edebug-points i))))
|
|
|
|
|
;; Insert all the indices for this line.
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(setq start-of-count-line (point)
|
|
|
|
|
first-index i ; really last index for line above this one.
|
|
|
|
|
last-count -1) ; cause first count to always appear.
|
|
|
|
|
(insert ";#")
|
|
|
|
|
;; i == first-index still
|
|
|
|
|
(while (<= (setq i (1+ i)) last-index)
|
|
|
|
|
(let ((count (aref counts i))
|
|
|
|
|
(coverage (aref coverages i))
|
|
|
|
|
(col (save-excursion
|
|
|
|
|
(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))) ?\ )
|
|
|
|
|
(if (and (< 0 count)
|
|
|
|
|
(not (memq coverage
|
|
|
|
|
'(unknown ok-coverage))))
|
|
|
|
|
"=" "")
|
|
|
|
|
(if (= count last-count) "" (int-to-string count))
|
|
|
|
|
" ")
|
|
|
|
|
(setq last-count count)))
|
|
|
|
|
(insert "\n")
|
|
|
|
|
(setq i first-index)))))
|
|
|
|
|
|
|
|
|
|
(defun edebug-temp-display-freq-count ()
|
|
|
|
|
"Temporarily display the frequency count data for the current definition.
|
|
|
|
|
It is removed when you hit any char."
|
|
|
|
|
;; This seems not to work with Emacs 18.59. It undoes too far.
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((buffer-read-only nil))
|
|
|
|
|
(undo-boundary)
|
|
|
|
|
(edebug-display-freq-count)
|
|
|
|
|
(setq unread-command-char (read-char))
|
|
|
|
|
(undo)))
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Menus
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defun edebug-toggle (variable)
|
|
|
|
|
(set variable (not (eval variable)))
|
|
|
|
|
(message "%s: %s" variable (eval variable)))
|
|
|
|
|
|
|
|
|
|
;; We have to require easymenu (even for Emacs 18) just so
|
|
|
|
|
;; the easy-menu-define macro call is compiled correctly.
|
|
|
|
|
(require 'easymenu)
|
|
|
|
|
|
|
|
|
|
(defconst edebug-mode-menus
|
|
|
|
|
'("Edebug"
|
|
|
|
|
"----"
|
|
|
|
|
["Stop" edebug-stop t]
|
|
|
|
|
["Step" edebug-step-mode t]
|
|
|
|
|
["Next" edebug-next-mode t]
|
|
|
|
|
["Trace" edebug-trace-mode t]
|
|
|
|
|
["Trace Fast" edebug-Trace-fast-mode t]
|
|
|
|
|
["Continue" edebug-continue-mode t]
|
|
|
|
|
["Continue Fast" edebug-Continue-fast-mode t]
|
|
|
|
|
["Go" edebug-go-mode t]
|
|
|
|
|
["Go Nonstop" edebug-Go-nonstop-mode t]
|
|
|
|
|
"----"
|
|
|
|
|
["Help" edebug-help t]
|
|
|
|
|
["Abort" abort-recursive-edit t]
|
|
|
|
|
["Quit to Top Level" top-level t]
|
|
|
|
|
["Quit Nonstop" edebug-top-level-nonstop t]
|
|
|
|
|
"----"
|
|
|
|
|
("Jumps"
|
|
|
|
|
["Forward Sexp" edebug-forward-sexp t]
|
|
|
|
|
["Step In" edebug-step-in t]
|
|
|
|
|
["Step Out" edebug-step-out t]
|
|
|
|
|
["Goto Here" edebug-goto-here t])
|
|
|
|
|
|
|
|
|
|
("Breaks"
|
|
|
|
|
["Set Breakpoint" edebug-set-breakpoint t]
|
|
|
|
|
["Unset Breakpoint" edebug-unset-breakpoint t]
|
|
|
|
|
["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t]
|
|
|
|
|
["Set Global Break Condition" edebug-set-global-break-condition t]
|
|
|
|
|
["Show Next Breakpoint" edebug-next-breakpoint t])
|
|
|
|
|
|
|
|
|
|
("Views"
|
|
|
|
|
["Where am I?" edebug-where t]
|
|
|
|
|
["Bounce to Current Point" edebug-bounce-point t]
|
|
|
|
|
["View Outside Windows" edebug-view-outside t]
|
|
|
|
|
["Previous Result" edebug-previous-result t]
|
|
|
|
|
["Show Backtrace" edebug-backtrace t]
|
|
|
|
|
["Display Freq Count" edebug-display-freq-count t])
|
|
|
|
|
|
|
|
|
|
("Eval"
|
|
|
|
|
["Expression" edebug-eval-expression t]
|
|
|
|
|
["Last Sexp" edebug-eval-last-sexp t]
|
|
|
|
|
["Visit Eval List" edebug-visit-eval-list t])
|
|
|
|
|
|
|
|
|
|
("Options"
|
|
|
|
|
["Edebug All Defs" edebug-all-defs t]
|
|
|
|
|
["Edebug All Forms" edebug-all-forms t]
|
|
|
|
|
"----"
|
|
|
|
|
["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]
|
|
|
|
|
))
|
|
|
|
|
"Lemacs style menus for Edebug.")
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Emacs version specific code
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;;; 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.
|
|
|
|
|
|
1994-04-05 01:21:06 +00:00
|
|
|
|
(defun edebug-emacs-19-specific ()
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(defalias 'edebug-window-live-p 'window-live-p)
|
|
|
|
|
|
|
|
|
|
;; Mark takes an argument in Emacs 19.
|
|
|
|
|
(defun edebug-mark ()
|
|
|
|
|
(mark t));; Does this work for lemacs too?
|
|
|
|
|
|
|
|
|
|
(defun edebug-set-conditional-breakpoint (arg condition)
|
|
|
|
|
"Set a conditional breakpoint at nearest sexp.
|
|
|
|
|
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)))))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
|
|
|
|
|
(if window-system
|
|
|
|
|
(x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug])))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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
|
1994-04-05 01:21:06 +00:00
|
|
|
|
((string-match "Lucid" emacs-version);; Lucid Emacs
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(edebug-lemacs-specific))
|
|
|
|
|
|
|
|
|
|
((and (boundp 'epoch::version) epoch::version)
|
1994-04-05 01:21:06 +00:00
|
|
|
|
(require 'edebug-epoch))
|
|
|
|
|
|
|
|
|
|
((not (string-match "^18" emacs-version))
|
|
|
|
|
(edebug-emacs-19-specific))))
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(edebug-emacs-version-specific)
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Byte-compiler
|
|
|
|
|
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Extension for bytecomp to resolve undefined function references.
|
|
|
|
|
;; Requires new byte compiler.
|
|
|
|
|
|
|
|
|
|
;; Reenable byte compiler warnings about unread-command-char and -event.
|
|
|
|
|
;; 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)))
|
|
|
|
|
|
|
|
|
|
(eval-when-compile
|
|
|
|
|
;; The body of eval-when-compile seems to get evaluated with eval-defun.
|
|
|
|
|
;; We only want to evaluate when actually byte compiling.
|
|
|
|
|
;; But it is OK to evaluate as long as byte-compiler has been loaded.
|
|
|
|
|
(if (featurep 'byte-compile) (progn
|
|
|
|
|
|
|
|
|
|
(defun byte-compile-resolve-functions (funcs)
|
|
|
|
|
"Say it is OK for the named functions to be unresolved."
|
|
|
|
|
(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
|
|
|
|
|
(lambda (var)
|
|
|
|
|
(setq byte-compile-free-references
|
|
|
|
|
(delq var byte-compile-free-references))))
|
|
|
|
|
vars)
|
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
'(defun byte-compile-resolve-free-assignments (vars)
|
|
|
|
|
"Say it is OK for the named variables to be assigned."
|
|
|
|
|
(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
|
1996-03-20 13:30:16 +00:00
|
|
|
|
edebug-gensym ;; also in cl.el
|
1994-03-24 20:38:34 +00:00
|
|
|
|
;; Interfaces to standard functions.
|
|
|
|
|
edebug-original-eval-defun
|
|
|
|
|
edebug-original-read
|
|
|
|
|
edebug-get-buffer-window
|
|
|
|
|
edebug-mark
|
|
|
|
|
edebug-mark-marker
|
|
|
|
|
edebug-input-pending-p
|
|
|
|
|
edebug-sit-for
|
|
|
|
|
edebug-prin1-to-string
|
|
|
|
|
edebug-format
|
|
|
|
|
;; lemacs
|
|
|
|
|
zmacs-deactivate-region
|
|
|
|
|
popup-menu
|
|
|
|
|
;; CL
|
|
|
|
|
cl-macroexpand-all
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;; And believe it or not, the byte compiler doesn't know about:
|
1994-03-24 20:38:34 +00:00
|
|
|
|
byte-compile-resolve-functions
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
'(byte-compile-resolve-free-references
|
|
|
|
|
'(read-expression-history
|
|
|
|
|
read-expression-map))
|
|
|
|
|
|
|
|
|
|
'(byte-compile-resolve-free-assignments
|
|
|
|
|
'(read-expression-history))
|
|
|
|
|
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Autoloading of Edebug accessories
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
(if (featurep 'cl)
|
|
|
|
|
(add-hook 'edebug-setup-hook
|
|
|
|
|
(function (lambda () (require 'cl-specs))))
|
|
|
|
|
;; The following causes cl-specs to be loaded if you load cl.el.
|
|
|
|
|
(add-hook 'cl-load-hook
|
|
|
|
|
(function (lambda () (require 'cl-specs)))))
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
|
1994-03-24 20:38:34 +00:00
|
|
|
|
(if (featurep 'cl-read)
|
|
|
|
|
(add-hook 'edebug-setup-hook
|
|
|
|
|
(function (lambda () (require 'edebug-cl-read))))
|
|
|
|
|
;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
|
|
|
|
|
(add-hook 'cl-read-load-hooks
|
|
|
|
|
(function (lambda () (require 'edebug-cl-read)))))
|
|
|
|
|
|
|
|
|
|
|
1996-03-20 13:30:16 +00:00
|
|
|
|
;;; Finalize Loading
|
1994-03-24 20:38:34 +00:00
|
|
|
|
|
|
|
|
|
;;; Finally, hook edebug into the rest of Emacs.
|
|
|
|
|
;;; There are probably some other things that could go here.
|
|
|
|
|
|
|
|
|
|
;; Install edebug read and eval functions.
|
|
|
|
|
(edebug-install-read-eval-functions)
|
1992-05-30 23:52:26 +00:00
|
|
|
|
|
1993-05-31 17:28:56 +00:00
|
|
|
|
(provide 'edebug)
|
|
|
|
|
|
1992-05-30 23:52:26 +00:00
|
|
|
|
;;; edebug.el ends here
|