liberte@M.CS.UIUC.EDU (Daniel LaLiberte) (01/30/89)
Here is a new version of edebug.el. It fixes several small bugs,
and leaves point at any syntax error it finds, setting mark to your
starting position (maybe that is not useful).
Dan LaLiberte
uiucdcs!liberte
liberte@cs.uiuc.edu
liberte%a.cs.uiuc.edu@uiucvmd.bitnet
====
;; edebug.el electric-debug mode or elisp-debug mode.
;; Copyright (C) 1988 Free Software Foundation, Inc. and Daniel LaLiberte
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;;================================================================
;;; This mode allows the user to step through elisp source code
;;; while executing, set breakpoints, etc. It works very well so far,
;;; but below is a list of things still to do. Help yourself
;;; if you feel inclinded to make enhancements and
;;; let me know if you come up with any ideas, bugs, or fixes.
;;; Daniel LaLiberte 217-333-7937
;;; University of Illinois, Urbana-Champaign
;;; Department of Computer Science
;;; 1304 W Springfield
;;; Urbana, IL 61801
;;; uiucdcs!liberte
;;; liberte@cs.uiuc.edu
;;; liberte%a.cs.uiuc.edu@uiucvmd.bitnet
;;; $Header: edebug.el,v 1.3 89/01/30 00:26:09 liberte Exp $
;;; $Log: edebug.el,v $
;;; Revision 1.3 89/01/30 00:26:09 liberte
;;; More bug fixes for cond and let.
;;; Another parsing fix backquote.
;;; Fix for lambda forms inside defuns.
;;; Oops, I shudda used rcs-mode to enter this.
;;; Leave point at syntax error, mark at starting position.
;;;
;;; Revision 1.2 88/11/28 12:14:15 liberte
;;; Bug fixes: cond construct didnt execute.
;;; () in sexp list didnt parse
;;; () as variable in condition-case didnt parse.
;;;
;;; Revision 1.1 88/11/28 12:11:27 liberte
;;; Initial revision
;;;
;;;========================================================================
;;; To use edebug, simply evaluate a defun with edebug-defun. Before
;;; calling the function, the buffer that the function is defined in
;;; must be available. Then call the function normally. In the debugger
;;; try the "h" command for a list of commands.
;;; Initially, you will be in step mode which stops before every
;;; expression. Continue to the next step with " " or "d".
;;; You can change to trace mode, which pauses one second before each
;;; expression, by using the "t" command. "T" is a fast trace with
;;; zero pause time. You can set a breakpoint with "b" and clear it
;;; with "B" inside the debugger or "C-xXb" and "C-xXB" outside.
;;; "c" continues until a break. "C" continues ignoring breaks.
;;; During trace or continue modes, hit any character to interrupt.
;;; You can view the window configuration outside of edebug with "v"
;;; and pop back to the edebug windows with "w" in a edebug window or
;;; "C-xXw" in any window. Quit to top level with "q" or abort one
;;; level with "a".
;; Put the following two forms in your .emacs file. The
;; local-set-key goes inside your emacs-lisp-mode-hook.
;;(local-set-key "\^Xx" 'edebug-defun)
;;(autoload 'edebug-defun "edebug")
;; Use setq to change the value of global-edebug-prefix before loading
;; edebug.el.
(defconst global-edebug-prefix "\^XX"
"Prefix key for global edebug commands.")
(defvar allow-recursive-debug t
"*If non-nil, recursive calls to edebug are not questioned.")
;;;=====================================================================
;; todo list * means difficult; may require mods to emacs
;; -------------------------------------------------------
;; Bug: occasionally, your elisp buffer will remain read-only.
;; *Annoyance: the debugging mode (trace, step, etc) is not reset on restart.
;; *Call edebug on exit from a function call.
;; *Previous result command.
;; Command to not descend but step to next call at same or higher level.
;; Maybe augment mark-list with next-at-same-level pointers.
;; *Maybe use some trick with backtrace-debug.
;; Make it work with selective display - dont stop in hidden lines
;; Command to display backtrace.
;; Handle macros?
;; Handle interactive form if the argument is not a string.
;; Per-function debugging mode?
;; Customizable default modes.
;; Should overlay-arrow-position and -string be buffer local?
;; Explicit calls to edebug in user code.
;; Use just one mark per function; compute relative position. - done
;; *Need to be able to recognize if a command has been executed at
;; a lower level since edebug was last called.
;; Remember window configuration inside debugger between edebug calls
;; and remember original configuration on the first call to edebug
;; after an interactive command at a lower level.
;; Write a replacement for, or fix, pop-to-buffer to avoid window-hopping.
;; Use copy of current-local-map instead of emacs-lisp-mode-map
;; (but only copy the first time after lower level command - to save time).
;; *Better integration with standard debug.
;; *Catch errors that would go to debug if in an edebug function.
;; Use inhibit-quit while edebugging?
;; Crawl mode would sit-for 0 or 1 in the outside window configuration
;; between each edebug step.
;; Maybe it should be a separate option that applies to trace as well.
;; Customizable sit-for time for trace and crawl modes.
;; Pause and continue at breakpoints if in continue mode?
;; (be sure to catch keyboard interrupt in time).
;; Conditional breakpoints. Enter expression to be evaluated.
;; Counting conditions - nth time through.
;; Environmental conditions - like nesting depth.
;; minibuffer mode - show the current line in the minibuffer instead.
;; Trace to buffer mode - print enclosing function and function at point.
;; Performance monitoring - summarize trace data.
;; Check that buffers havent disappeared under us.
;; List side effects of using edebug, e.g. last-command, undo, etc.
;; Handle expressions outside of defuns. Store mark-list in global var.
;; Debug just one subexpression of a defun - the rest is evalled normally.
;; Speed up edebug-defun.
;; Shadow eval-defun or eval-region temporarily.
;;;======================================================================
;;; The first half of this file is the edebug compiler, edebug-defun.
;;; The second half is the debugger, edebug and edebug-mode.
;;; Some general utilities are at the end.
;(setq debug-on-error t)
(defun edebug-defun ()
"Evaluate the defun that point is in or before,
but set it up for edebug. Print its name in the minibuffer."
(interactive)
(let ((tmp-point (point))
(defun-name)
(defun-args)
(defun-doc-string)
(defun-interactive)
(parse-sexp-ignore-comments t)
sexp token
(edebug-sexp-count 0)
edebug-point-list
edebug-func-mark
(starting-point (point))
)
(condition-case err
(progn
(end-of-defun)
(beginning-of-defun)
(down-list 1)
(setq edebug-func-mark (point-marker))
(if (not (eq 'defun (edebug-read-one)))
(edebug-syntax-error "Not in a defun"))
(setq defun-name (edebug-read-one))
(if (not (symbolp defun-name))
(edebug-syntax-error "Bad defun name."))
(setq defun-args (edebug-read-one))
(if (not (listp defun-args))
(edebug-syntax-error "Bad defun arg list."))
;; look for doc string
(setq tmp-point (point))
(if (eq 'atom (edebug-next-token-class))
(setq token (edebug-read-one)))
(if (stringp token)
(progn
(setq defun-doc-string token)
(setq tmp-point (point))
))
;; look for interactive form
(if (eq 'lparen (edebug-next-token-class))
(progn
(forward-char 1) ; skip \(
(if (eq 'atom (edebug-next-token-class))
(progn
(setq token (edebug-read-one))
(goto-char tmp-point)
(if (eq 'interactive token)
(progn
(setq defun-interactive (edebug-read-one))
(setq tmp-point (point))
)
)))))
(goto-char tmp-point)
;; the remainder is a list of sexps
(fset defun-name (` (lambda
(, defun-args)
(, defun-doc-string)
(, defun-interactive)
(,@ (edebug-sexp-list t))
)))
(goto-char starting-point) ; recover point like save-excursion
; but only if no error occurs
(put defun-name 'edebug
(list edebug-func-mark
nil ; clear breakpoints
(vconcat (nreverse edebug-point-list)))
)
(message "edebug: %s" defun-name)
)
(invalid-read-syntax
(save-excursion ; set mark at starting-point so user can return
(goto-char starting-point)
(set-mark-command nil))
(message "Syntax error: %s" (cdr err))
; (signal 'invalid-read-syntax (cdr err)) ; pass it on
)
) ; condition-case
))
(defun edebug-sexp ()
"Return the debug form for the following sexp. Move point to
immediately after the sexp. Also add the offset of each sexp to
the edebug-point-list for the function."
(let* ((sexp-point (- (point) edebug-func-mark))
(count (1- (setq edebug-sexp-count (1+ edebug-sexp-count))))
sexp
)
(setq edebug-point-list (cons sexp-point edebug-point-list))
;; this must be done after adding point to list
;; because edebug-form will add more points
(setq sexp
(cond
((eq 'lparen (edebug-next-token-class)) (edebug-form))
(t (edebug-read-one))))
;; could use ` here
(list 'progn
(list 'edebug (list 'quote defun-name) count)
sexp)
))
(defun edebug-sexp-list (debuggable)
"Return a list built from the sexp list following point in the
current buffer. If DEBUGGABLE then wrap edebug calls around each sexp.
Leave point before the trailing right paren."
(let ((sexp-list)
sexp
class
)
(while (not (eq 'rparen (setq class (edebug-next-token-class))))
(setq sexp (if debuggable
(edebug-sexp)
(edebug-read-one)))
;; (message "sexp after debug: %s" sexp) (sit-for 2)
(setq sexp-list (cons sexp sexp-list))
)
(nreverse sexp-list)
))
(defun edebug-form ()
"Return an edebug list built from the list form that follows point.
Insert debug calls as appropriate to the form.
Leave point after the right paren."
(let ((beginning (point))
class
head)
(forward-char 1) ; skip \(
(cond
((eq 'atom (setq class (edebug-next-token-class)))
(setq head (edebug-read-one)))
((eq 'rparen class)
(setq head nil))
((eq 'lparen class)
(setq head (edebug-read-one))) ; should be a lambda expression
(t (edebug-syntax-error
"Head of list must be a symbol or lambda expression.")
))
(prog1
(and head
(cons head
(cond
;; handle all special-forms with unevaluated arguments
((memq head '(let let*)) (edebug-let))
((memq head '(setq setq-default)) (edebug-setq))
((eq head 'cond) (edebug-cond))
((eq head 'condition-case) (edebug-condition-case))
((memq head '(quote function
defun defvar defconst defmacro))
(edebug-sexp-list nil))
;; is it a lisp macro?
((macrop head) (edebug-sexp-list nil))
(t (edebug-sexp-list t))
)))
(forward-char 1) ; skip \)
)
))
(defun edebug-let ()
(let (var-value-list
token
class)
(cons
;; first process the var/value list
(if (not (eq 'lparen (edebug-next-token-class)))
(if (setq token (edebug-read-one))
(edebug-syntax-error "Bad var list in let.") ; should be nil
token
)
(forward-char 1) ; lparen
(while (not (eq 'rparen (setq class (edebug-next-token-class))))
(setq var-value-list
(cons
(if (not (eq 'lparen class))
(edebug-read-one)
(forward-char 1) ; lparen
(prog1
(edebug-var-value)
(if (not (eq 'rparen (edebug-next-token-class)))
(edebug-syntax-error "Right paren expected in let.")
(forward-char 1) ; rparen
))
)
var-value-list)))
(forward-char 1) ; rparen
(nreverse var-value-list)
)
;; now process the expression list
(progn
(edebug-next-token)
(edebug-sexp-list t))
)))
(defun edebug-var-value ()
"Return the debug form of the var and optional value that follow point.
Leave point after the value, if there is one."
(list
(edebug-read-one) ; the variable
(and (not (eq 'rparen (edebug-next-token-class)))
(edebug-sexp))
))
(defun edebug-setq ()
"Return the debug form of the setq var-value list."
(let (var-value-list)
(while (not (eq 'rparen (edebug-next-token-class)))
(setq var-value-list
(append var-value-list
(edebug-var-value))))
var-value-list
))
(defun edebug-cond ()
"Return the debug form of the cond condition-expressionlist pairs."
(let (value-value-list
class)
(while (not (eq 'rparen (setq class (edebug-next-token-class))))
(setq value-value-list
(cons
(if (not (eq 'lparen class))
(let ((thing (edebug-read-one)))
(if thing
(edebug-syntax-error "Condition expected in cond")
nil))
(forward-char 1) ; \(
(prog1
(cons
(edebug-sexp)
(if (eq 'rparen (edebug-next-token-class))
nil
(edebug-sexp-list t)))
(if (not (eq 'rparen (edebug-next-token-class)))
(edebug-syntax-error "Right paren expected in cond"))
(forward-char 1) ; \)
))
value-value-list))
)
(nreverse value-value-list)
))
(defun edebug-condition-case ()
"Return the debug form of a condition-case."
(let (symb-sexp-list
class
token)
(cons
(prog1
;; read the variable or nil
(setq token (edebug-read-one))
(if (not (symbolp token))
(edebug-syntax-error
(format "Bad symbol in condition-case: %s" token)))
(edebug-next-token))
(cons
(edebug-sexp) ; the form
;; process handlers
(progn
(while (not (eq 'rparen (setq class (edebug-next-token-class))))
(setq symb-sexp-list
(cons
(if (not (eq 'lparen class))
(edebug-syntax-error "Bad handler in condition-case")
(forward-char 1) ; \(
(prog1
(edebug-var-value)
(forward-char 1)) ; \)
)
symb-sexp-list)))
(nreverse symb-sexp-list)
)))))
;;------------------------------------------------
;; Parser utilities
(defun edebug-syntax-error (msg)
"Signal an invalid-read-syntax with MSG. This is caught by edebug-defun."
(signal 'invalid-read-syntax msg))
(defun edebug-next-token ()
"Leave point before the next token skipping comments."
(skip-chars-forward " \t\r\n\f")
(while (= (following-char) ?\;)
(end-of-line)
(skip-chars-forward " \t\r\n\f")
))
(defun edebug-read-one ()
"Read one sexp from the current buffer starting at point. Leave
point immediately after it. A sexp can be a list or atom (symbol,
character, string, vector)."
;; This is gummed up by parser inconsistencies (bugs?)
(let ((parse-sexp-ignore-comments t)
token)
(edebug-next-token)
(if (= (following-char) ?\[) ; scan-sexps doesnt read vectors correctly
(setq token (read (current-buffer))) ; but read does
(goto-char
(min ; use the lesser of the read and scan-sexps motion
(save-excursion
;; read goes one too far if (quoted) string or symbol
;; is immediately followed by non-whitespace
(setq token (read (current-buffer)))
(point))
;; scan-sexps reads too far if a quoting character is read
(scan-sexps (point) 1)))
)
token
))
(defun edebug-next-token-class ()
"Move to the next token and return its class. We only care about
parens, dot, quote, and atom (anything else)."
(edebug-next-token)
(let ((c (following-char)))
(cond
((= c ?\() 'lparen)
((= c ?\)) 'rparen)
((= c ?\.) 'dot)
((= c ?\') 'quote)
(t 'atom))))
;;;=================================================================
;;; The debugger itself
;;; add minor-mode-alist entry
(or (assq 'edebug-active minor-mode-alist)
(setq minor-mode-alist (cons (list 'edebug-active " *Debugging*")
minor-mode-alist)))
(defconst edebug-arrow-alist
'((continue . "*>")
(trace . "->")
(fast . ">")
(step . "=>"))
"Association list of arrows for each edebug mode.")
(defvar edebug-depth 0
"Current debug editing depth.")
;; These variables need to be maintained between edebug calls.
;; But recursive edebug calls could confuse them.
(defvar edebug-window-start 0
"Remember where each buffers' window starts. This is to avoid
spurious recentering and also to auto adjust window start.")
;; what about a buffer with more than one window?
(setq-default edebug-window-start 0)
(make-variable-buffer-local 'edebug-window-start)
(defvar edebug-inside-window-configuration nil
"Configuration of debugger windows.")
(defvar edebug-outside-window-configuration nil
"Configuration of windows before debugger.")
;;-------------------------------------------------
(defun edebug (edebug-func edebug-point-index)
"Debug FUNC. The position of the current sexp is given by POINT-INDEX
which is used to index a point in the point vector in the functions
'edebug property. edebug is called from functions compiled with edebug-defun."
;; remember, nothing is safe until save-excursion etc.
(if (or (= 0 edebug-depth) allow-recursive-debug
(y-or-n-p "Recursive debug?? "))
(if (and (eq edebug-mode 'sleep) (not (input-pending-p)))
nil
;; some variables are declared here to allow recursive debugging
(let ((edebug-match-data (match-data))
edebug-outside-map ; keymap before edebug
(edebug-outside-buffer (current-buffer))
edebug-read-only
(edebug-outside-point (point))
(edebug-active t)
edebug-buffer
(edebug-step-after-exit nil)
(cursor-in-echo-area nil) ; ??
(edebug-data (get edebug-func 'edebug))
edebug-func-mark ; mark at function start
edebug-breakpoints ; list of breakpoints
edebug-break ; true if we should break now
edebug-point
edebug-recursive
(edebug-outside-arrow-position overlay-arrow-position)
(edebug-outside-arrow-string overlay-arrow-string)
)
(save-excursion
(unwind-protect
(progn
(setq edebug-outside-window-configuration
(current-window-configuration))
(setq edebug-depth (1+ edebug-depth))
;; pull out parts of the edebug-data
(setq edebug-func-mark (car edebug-data))
(setq edebug-breakpoints (car (cdr edebug-data)))
(setq edebug-point (+ edebug-func-mark
(aref (car (cdr (cdr edebug-data)))
edebug-point-index)))
(setq edebug-buffer (marker-buffer edebug-func-mark))
(setq edebug-break
(memq edebug-point-index edebug-breakpoints))
(if (or (not (eq 'continue edebug-mode))
edebug-break
(input-pending-p))
(progn
(if (input-pending-p)
(progn
;;(setq edebug-mode 'step)
(setq edebug-recursive t)
(message "Interrupted")
;;(discard-input) ; can we use this input safely?
;;(sit-for 1)
))
;;(make-local-variable 'overlay-arrow-position)
;;(make-local-variable 'overlay-arrow-string)
;;; Dont use the following since we dont know if
;;; this is the first time in debug since last command at lower level.
;;; (if edebug-inside-window-configuration
;;; (set-window-configuration
;;; edebug-inside-window-configuration))
;; avoid window-hopping for > 2 windows
;; doesnt catch all cases yet
(if (and (not (get-buffer-window edebug-buffer))
(not (eq (selected-window)
(next-window (next-window
(selected-window))))))
(progn
; (message "flipping windows") (sit-for 2)
(select-window (get-lru-window))
))
;; a substitute for pop-to-buffer might be simpler
(pop-to-buffer edebug-buffer)
(set-buffer edebug-buffer)
(goto-char edebug-point)
;; adjust window to fit as much as possible
(set-window-start (selected-window)
edebug-window-start)
(if (not (pos-visible-in-window-p))
(let ((start (window-start)))
(set-window-start
(selected-window)
(setq edebug-window-start
(save-excursion
(forward-line
(if (< edebug-point start) -1
(- (/ (window-height) 2))))
(beginning-of-line)
(point))))))
(edebug-overlay-arrow)
;; (sit-for 0)
(if (and (not edebug-break)
(memq edebug-mode '(trace fast)))
(if (eq edebug-mode 'trace)
(sit-for 1) ; parameterize time
(sit-for 0))
(if (and edebug-break
(not (eq 'step edebug-mode)))
(message "Break"))
(setq edebug-recursive t)
)))
(if edebug-recursive
(progn
(edebug-mode)
(setq edebug-read-only buffer-read-only)
(let ((buffer-read-only t)) ; could make this optional
(setq edebug-inside-window-configuration
(current-window-configuration))
(unwind-protect
(recursive-edit)
(set-buffer edebug-buffer)) ; may have changed buffers
)))
)
;; unwind-protect cleanup
(if edebug-recursive
(progn
(save-excursion
(set-buffer edebug-buffer)
(use-local-map edebug-outside-map))
(if (not (eq buffer-read-only edebug-read-only))
(error
"This should not happen! \
Read-only changed from %s to %s"
edebug-read-only
buffer-read-only))
))
;; (message "Unwinding. depth=%d" (recursion-depth)) (sit-for 2)
(restore-match-data edebug-match-data)
(setq edebug-depth (1- edebug-depth))
(set-window-configuration edebug-outside-window-configuration)
(setq overlay-arrow-position edebug-outside-arrow-position)
(setq overlay-arrow-string edebug-outside-arrow-string)
) ; unwind-protect
)))))
(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-mode."
(let* ((pos))
(save-excursion
(beginning-of-line)
(setq pos (point)))
(setq overlay-arrow-string
(cdr (assq edebug-mode edebug-arrow-alist)))
(setq overlay-arrow-position (make-marker))
(set-marker overlay-arrow-position pos (current-buffer))
))
(defun edebug-modify-breakpoint (flag)
"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."
;; must find the right debugger data first
(let (defun-name
edebug-data
edebug-func-mark
edebug-breakpoints
)
(save-excursion
(end-of-defun)
(beginning-of-defun)
(down-list 1)
(forward-sexp 1)
(setq defun-name (read (current-buffer))))
(setq edebug-data (get defun-name 'edebug))
(if (not edebug-data)
(error "%s must first be evaluated with edebug-defun." defun-name))
;; pull out parts of edebug-data
(setq edebug-func-mark (car edebug-data))
(setq edebug-breakpoints (car (cdr edebug-data)))
(let ((point-vector (car (cdr (cdr edebug-data))))
(pnt (point))
len i)
;; assume that the marks are in order
(setq len (length mark-vector))
(setq i 0)
(while (and (< i len) (> pnt (aref point-vector i)))
(setq i (1+ i)))
(if (<= pnt (aref point-vector i))
(progn ; found it
(setq edebug-breakpoints (delq i edebug-breakpoints))
(if flag
(progn
(setq edebug-breakpoints (cons i edebug-breakpoints))
(message "Breakpoint set."))
(message "Breakpoint cleared."))
(setq edebug-data
(list edebug-func-mark edebug-breakpoints point-vector))
(put defun-name 'edebug edebug-data)
(goto-char (aref point-vector i))
))
)))
(defun edebug-set-breakpoint ()
"Set the breakpoint of sexp following point."
(interactive)
(edebug-modify-breakpoint t))
(defun edebug-clear-breakpoint ()
"Clear the breakpoint of sexp following point."
(interactive)
(edebug-modify-breakpoint nil))
(defun edebug-step-through ()
"Proceed to next debug step."
(interactive)
(setq edebug-mode 'step)
(if (< 0 (recursion-depth))
(if (eq (current-buffer) edebug-buffer)
(exit-recursive-edit))
(message "edebug will stop before next eval.")))
(defun edebug-sleep ()
"Continue, evaluating without debugging."
(interactive)
(message "Sleep...")
(setq edebug-mode 'sleep)
(if (< 0 (recursion-depth))
(if (eq (current-buffer) edebug-buffer)
(exit-recursive-edit))
(message "edebug will sleep through breaks.")))
(defun edebug-continue ()
"Continue, evaluating until break."
(interactive)
(message "Continue...")
(setq edebug-mode 'continue)
(if (< 0 (recursion-depth))
(if (eq (current-buffer) edebug-buffer)
(exit-recursive-edit))
(message "edebug will continue until break." )))
(defun edebug-trace-fast ()
"Trace with no wait at each step."
(interactive)
(message "Trace fast...")
(setq edebug-mode 'fast)
(if (< 0 (recursion-depth))
(if (eq (current-buffer) edebug-buffer)
(exit-recursive-edit))
(message "edebug will trace without pause.")))
(defun edebug-trace ()
"Begin trace mode."
(interactive)
(message "Tracing...")
(sit-for 1) ; or delay time
(setq edebug-mode 'trace)
(if (< 0 (recursion-depth))
(if (eq (current-buffer) edebug-buffer)
(exit-recursive-edit))
(message "edebug will trace with pause.")))
(defun edebug-where ()
"Show the debug windows and where we stopped in program."
(interactive)
(set-window-configuration edebug-inside-window-configuration)
(set-buffer edebug-buffer)
(select-window (get-buffer-window edebug-buffer)) ; is this needed?
(goto-char edebug-point) ; from edebug
(message "Window configuration inside of edebug.")
)
(defun edebug-view-outside ()
"Show the windows before edebug was called."
(interactive)
(set-window-configuration edebug-outside-window-configuration)
(goto-char edebug-outside-point)
(message "Window configuration outside of edebug. Return with %s"
(substitute-command-keys "\\<global-map>\\[edebug-where]"))
)
(defun edebug-bounce-point ()
"Show the point in the outside current buffer by bouncing. If the
buffer has a current window, then dont do a set-window-configuration"
(interactive)
(save-excursion
(if (not (get-buffer-window edebug-outside-buffer))
(progn
(set-window-configuration edebug-outside-window-configuration)
(sit-for 1)
(set-window-configuration edebug-inside-window-configuration)
)
(save-window-excursion
(select-window (get-buffer-window edebug-outside-buffer))
(goto-char edebug-outside-point)
(sit-for 0) ; I want to sit one second after update is finished!
(sit-for 1))
)))
(defun edebug-interrupt ()
"Useful for exiting from trace loop."
(interactive)
(message "Interrupted")
(ding t))
(defun edebug-eval-expression (exp)
"Prompt and evaluate an expression"
(interactive "xEval: ")
(save-excursion
(if (null (buffer-name edebug-outside-buffer))
;; outside buffer deleted
(setq edebug-outside-buffer (current-buffer)))
(set-buffer edebug-outside-buffer)
(eval-expression exp)))
;;;------------------
;;; edebug-mode stuff
(defvar edebug-mode-map nil)
(if edebug-mode-map
nil
(let ((loop ? )) ; what's this for?
;; should use copy of current local map
(setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
;; (suppress-keymap edebug-mode-map)
(define-key edebug-mode-map "-" 'negative-argument)
(define-key edebug-mode-map "c" 'edebug-continue)
(define-key edebug-mode-map "C" 'edebug-sleep)
(define-key edebug-mode-map "t" 'edebug-trace)
(define-key edebug-mode-map "T" 'edebug-trace-fast)
(define-key edebug-mode-map " " 'edebug-step-through)
(define-key edebug-mode-map "d" 'edebug-step-through)
(define-key edebug-mode-map "w" 'edebug-where)
(define-key edebug-mode-map "v" 'edebug-view-outside)
(define-key edebug-mode-map "p" 'edebug-bounce-point)
(define-key edebug-mode-map "h" 'edebug-help)
(define-key edebug-mode-map "?" 'edebug-help)
(define-key edebug-mode-map "q" 'top-level)
(define-key edebug-mode-map "a" 'abort-recursive-edit)
(define-key edebug-mode-map "e" 'edebug-eval-expression)
(define-key edebug-mode-map "b" 'edebug-set-breakpoint)
(define-key edebug-mode-map "B" 'edebug-clear-breakpoint)
(define-key edebug-mode-map "i" 'edebug-interrupt)
(define-key edebug-mode-map "\^g" 'edebug-interrupt)
))
(defvar global-edebug-map (make-sparse-keymap))
(define-key global-edebug-map "d" 'edebug-step-through)
(define-key global-edebug-map "c" 'edebug-continue)
(define-key global-edebug-map "C" 'edebug-sleep)
(define-key global-edebug-map "t" 'edebug-trace)
(define-key global-edebug-map "T" 'edebug-trace-fast)
(define-key global-edebug-map "b" 'edebug-set-breakpoint)
(define-key global-edebug-map "B" 'edebug-clear-breakpoint)
(define-key global-edebug-map "w" 'edebug-where)
(global-set-key global-edebug-prefix global-edebug-map)
(defvar edebug-mode 'step
"Current edebug mode set by user.")
(defun edebug-help ()
(interactive)
(describe-function 'edebug-mode))
(defun edebug-mode ()
"Mode for elisp buffers while in edebug. Under construction.
There are both buffer local and global key bindings to several
functions. E.g. edebug-step-through is bound to
\\[edebug-step-through] in the debug buffer and
\\<global-map>\\[edebug-step-through] in any buffer.
Global commands prefixed by global-edbug-prefix:
\\{global-edebug-map}
Debugger buffer commands
\\{edebug-mode-map}
"
(setq edebug-outside-map (current-local-map))
(use-local-map edebug-mode-map)
)
;;;--------------------
;;; Utilities
(defun window-list ()
"Return a list of window, in order of next-window."
(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)))
(defun restore-match-data (data)
"Restore the match data DATA safely."
(catch 'foo
(let ((d data))
(while d
(and (car d)
(null (marker-buffer (car d)))
;; match-data buffer is deleted.
(throw 'foo nil))
(setq d (cdr d)))
(store-match-data data)
)))
(defun macrop (object)
"Return true if OBJECTs function is a lisp macro, directly or indirectly."
(while (and (symbolp object) (fboundp object))
(setq object (symbol-function object)))
(and (listp object)
(eq 'macro (car object)))
)