;;; edebug.el --- a source-level debugger for Emacs Lisp
-;; Copyright (C) 1988,89,90,91,92,93,94,95,97,1999,2000,01,03,2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1999,
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Maintainer: FSF
;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; Form spec utilities.
-;;;###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
-\(naming a function), or a list."
- `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
-
(defmacro def-edebug-form-spec (symbol spec-form)
- "For compatibility with old version. Use `def-edebug-spec' instead."
- (message "Obsolete: use def-edebug-spec instead.")
+ "For compatibility with old version."
(def-edebug-spec symbol (eval spec-form)))
+(make-obsolete 'def-edebug-form-spec 'def-edebug-spec "22.1")
(defun get-edebug-spec (symbol)
;; Get the spec of symbol resolving all indirection.
edebug-form-spec
))
+;;;###autoload
+(defun edebug-basic-spec (spec)
+ "Return t if SPEC uses only extant spec symbols.
+An extant spec symbol is a symbol that is not a function and has a
+`edebug-form-spec' property."
+ (cond ((listp spec)
+ (catch 'basic
+ (while spec
+ (unless (edebug-basic-spec (car spec)) (throw 'basic nil))
+ (setq spec (cdr spec)))
+ t))
+ ((symbolp spec)
+ (unless (functionp spec) (get spec 'edebug-form-spec)))))
+
;;; Utilities
;; Define edebug-gensym - from old cl.el
(defun edebug-pop-to-buffer (buffer &optional window)
;; Like pop-to-buffer, but select window where BUFFER was last shown.
- ;; Select WINDOW if it provided and it still exists. Otherwise,
+ ;; Select WINDOW if it is provided and still exists. Otherwise,
;; if buffer is currently shown in several windows, choose one.
;; Otherwise, find a new window, possibly splitting one.
- (setq window (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))
- ;; Don't select trace window
- nil
- (select-window (next-window))))
- (set-window-buffer (selected-window) buffer)
- (set-window-hscroll (selected-window) 0);; should this be??
+ (setq window
+ (cond
+ ((and (edebug-window-live-p window)
+ (eq (window-buffer window) buffer))
+ window)
+ ((eq (window-buffer (selected-window)) buffer)
+ ;; Selected window already displays BUFFER.
+ (selected-window))
+ ((edebug-get-buffer-window buffer))
+ ((one-window-p 'nomini)
+ ;; When there's one window only, split it.
+ (split-window))
+ ((let ((trace-window (get-buffer-window edebug-trace-buffer)))
+ (catch 'found
+ (dolist (elt (window-list nil 'nomini))
+ (unless (or (eq elt (selected-window)) (eq elt trace-window)
+ (window-dedicated-p elt))
+ ;; Found a non-dedicated window not showing
+ ;; `edebug-trace-buffer', use it.
+ (throw 'found elt))))))
+ ;; All windows are dedicated or show `edebug-trace-buffer', split
+ ;; selected one.
+ (t (split-window))))
+ (select-window window)
+ (set-window-buffer window buffer)
+ (set-window-hscroll window 0);; should this be??
;; Selecting the window does not set the buffer until command loop.
;;(set-buffer buffer)
)
-
(defun edebug-get-displayed-buffer-points ()
;; Return a list of buffer point pairs, for all displayed buffers.
(let (list)
;; Compatibility with old versions.
(defalias 'edebug-all-defuns 'edebug-all-defs)
+;;;###autoload
(defun edebug-all-defs ()
"Toggle edebugging of all definitions."
(interactive)
(if edebug-all-defs "on" "off")))
+;;;###autoload
(defun edebug-all-forms ()
"Toggle edebugging of all forms."
(interactive)
;; Leave point before the next token, skipping white space and comments.
(skip-chars-forward " \t\r\n\f")
(while (= (following-char) ?\;)
- ;; \r is counted as a comment terminator to support selective display.
- (skip-chars-forward "^\n\r") ; skip the comment
+ (skip-chars-forward "^\n") ; skip the comment
(skip-chars-forward " \t\r\n\f")))
head (edebug-move-cursor cursor))))))
((consp head)
- (if (eq (car head) ',)
+ (if (eq (car head) '\,)
;; The head of a form should normally be a symbol or a lambda
;; expression but it can also be an unquote form to be filled
;; before evaluation. We evaluate the arguments anyway, on the
((fboundp symbol) ; is it a predicate?
(let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
;; Special case for edebug-`.
- (if (and (listp sexp) (eq (car sexp) ',))
+ (if (and (listp sexp) (eq (car sexp) '\,))
(edebug-match cursor '(("," def-form)))
(if (not (funcall symbol sexp))
(edebug-no-match cursor symbol "failed"))
(def-edebug-spec edebug-\` (def-form))
;; Assume immediate quote in unquotes mean backquote at next higher level.
-(def-edebug-spec , (&or ("quote" edebug-\`) def-form))
-(def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped.
+(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.
(defun edebug-slow-before (edebug-before-index)
- ;; Debug current function given BEFORE position.
- ;; Called from functions compiled with edebug-eval-top-level-form.
- ;; Return the before index.
- (setcar edebug-offset-indices edebug-before-index)
-
- ;; Increment frequency count
- (aset edebug-freq-count edebug-before-index
- (1+ (aref edebug-freq-count edebug-before-index)))
-
- (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
- (edebug-input-pending-p))
- (edebug-debugger edebug-before-index 'before nil))
+ (unless edebug-active
+ ;; Debug current function given BEFORE position.
+ ;; Called from functions compiled with edebug-eval-top-level-form.
+ ;; Return the before index.
+ (setcar edebug-offset-indices edebug-before-index)
+
+ ;; Increment frequency count
+ (aset edebug-freq-count edebug-before-index
+ (1+ (aref edebug-freq-count edebug-before-index)))
+
+ (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
+ (edebug-input-pending-p))
+ (edebug-debugger edebug-before-index 'before nil)))
edebug-before-index)
(defun edebug-fast-before (edebug-before-index)
)
(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
- ;; Debug current function given AFTER position and VALUE.
- ;; Called from functions compiled with edebug-eval-top-level-form.
- ;; Return VALUE.
- (setcar edebug-offset-indices edebug-after-index)
-
- ;; Increment frequency count
- (aset edebug-freq-count edebug-after-index
- (1+ (aref edebug-freq-count edebug-after-index)))
- (if edebug-test-coverage (edebug-update-coverage))
-
- (if (and (eq edebug-execution-mode 'Go-nonstop)
- (not (edebug-input-pending-p)))
- ;; Just return result.
+ (if edebug-active
edebug-value
- (edebug-debugger edebug-after-index 'after edebug-value)
- ))
+ ;; Debug current function given AFTER position and VALUE.
+ ;; Called from functions compiled with edebug-eval-top-level-form.
+ ;; Return VALUE.
+ (setcar edebug-offset-indices edebug-after-index)
+
+ ;; Increment frequency count
+ (aset edebug-freq-count edebug-after-index
+ (1+ (aref edebug-freq-count edebug-after-index)))
+ (if edebug-test-coverage (edebug-update-coverage))
+
+ (if (and (eq edebug-execution-mode 'Go-nonstop)
+ (not (edebug-input-pending-p)))
+ ;; Just return result.
+ edebug-value
+ (edebug-debugger edebug-after-index 'after edebug-value)
+ )))
(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
;; Do nothing but return the value.
(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
+(defvar edebug-outside-d-c-i-n-s-w) ; outside default-cursor-in-non-selected-windows
(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
;; Uses local variables of edebug-enter, edebug-before, edebug-after
;; and edebug-debugger.
(let ((edebug-active t) ; for minor mode alist
+ (edebug-with-timeout-suspend (with-timeout-suspend))
edebug-stop ; should we enter recursive-edit
(edebug-point (+ edebug-def-mark
(aref (nth 2 edebug-data) edebug-offset-index)))
(edebug-outside-buffer (current-buffer))
(edebug-outside-point (point))
(edebug-outside-mark (edebug-mark))
+ (edebug-outside-unread-command-events unread-command-events)
edebug-outside-windows ; window or screen configuration
edebug-buffer-points
(edebug-outside-o-a-p overlay-arrow-position)
(edebug-outside-o-a-s overlay-arrow-string)
- (edebug-outside-c-i-e-a cursor-in-echo-area))
+ (edebug-outside-c-i-e-a cursor-in-echo-area)
+ (edebug-outside-d-c-i-n-s-w default-cursor-in-non-selected-windows))
(unwind-protect
(let ((overlay-arrow-position overlay-arrow-position)
(overlay-arrow-string overlay-arrow-string)
(cursor-in-echo-area nil)
+ (default-cursor-in-non-selected-windows t)
+ (unread-command-events unread-command-events)
;; any others??
)
(if (not (buffer-name edebug-buffer))
(t (message "")))
+ (setq unread-command-events nil)
(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-sit-for edebug-sit-for-seconds)) ; Show message.
(edebug-previous-result)))
(cond
(edebug-break
(cond
- ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
+ ((eq edebug-execution-mode 'continue)
+ (edebug-sit-for edebug-sit-for-seconds))
((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
(t (setq edebug-stop t))))
;; not edebug-break
((eq edebug-execution-mode 'trace)
(edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause.
((eq edebug-execution-mode 'Trace-fast)
- (edebug-sit-for 0)) ; Force update and continue.
- )
+ (edebug-sit-for 0))) ; Force update and continue.
(unwind-protect
(if (or edebug-stop
;; Unrestore edebug-buffer's window-start, if displayed.
(let ((window (car edebug-window-data)))
- (if (and window (edebug-window-live-p window)
+ (if (and (edebug-window-live-p window)
(eq (window-buffer) edebug-buffer))
(progn
(set-window-start window (cdr edebug-window-data)
) ; if edebug-save-windows
;; Restore current buffer always, in case application needs it.
- (set-buffer edebug-outside-buffer)
+ (if (buffer-name edebug-outside-buffer)
+ (set-buffer edebug-outside-buffer))
;; Restore point, and mark.
;; Needed even if restoring windows because
;; that doesn't restore point and mark in the current buffer.
(set-buffer current-buffer))
;; ... nothing more.
)
+ (with-timeout-unsuspend edebug-with-timeout-suspend)
;; Reset global variables to outside values in case they were changed.
(setq
+ unread-command-events edebug-outside-unread-command-events
overlay-arrow-position edebug-outside-o-a-p
overlay-arrow-string edebug-outside-o-a-s
- cursor-in-echo-area edebug-outside-c-i-e-a)
+ cursor-in-echo-area edebug-outside-c-i-e-a
+ default-cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
)))
(edebug-outside-last-input-event last-input-event)
(edebug-outside-last-command-event last-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)
;; More for Emacs 19
(last-input-event nil)
(last-command-event nil)
- (unread-command-events nil)
(last-event-frame nil)
(last-nonmenu-event nil)
(track-mouse nil)
(edebug-overlay-arrow))
(setq buffer-read-only edebug-buffer-read-only)
(use-local-map edebug-outside-map)
+ (remove-hook 'kill-buffer-hook 'edebug-kill-buffer t)
)
;; gotta have a buffer to let its buffer local variables be set
(get-buffer-create " bogus edebug buffer"))
last-command edebug-outside-last-command
this-command edebug-outside-this-command
unread-command-char edebug-outside-unread-command-char
- unread-command-events edebug-outside-unread-command-events
current-prefix-arg edebug-outside-current-prefix-arg
last-input-char edebug-outside-last-input-char
last-input-event edebug-outside-last-input-event
func)
(t
(let ((loc (find-function-noselect func)))
+ (unless (cdr loc)
+ (error "Could not find the definition in its file"))
(with-current-buffer (car loc)
(goto-char (cdr loc))
(edebug-eval-top-level-form)
(overlay-arrow-position edebug-outside-o-a-p)
(overlay-arrow-string edebug-outside-o-a-s)
(cursor-in-echo-area edebug-outside-c-i-e-a)
+ (default-cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
)
(unwind-protect
(save-excursion ; of edebug-buffer
edebug-outside-o-a-p overlay-arrow-position
edebug-outside-o-a-s overlay-arrow-string
edebug-outside-c-i-e-a cursor-in-echo-area
+ edebug-outside-d-c-i-n-s-w default-cursor-in-non-selected-windows
)
;; Restore the outside saved values; don't alter
;;; Printing
-;; Replace printing functions.
-
-;; obsolete names
-(defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
-(defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
-(defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print)
-
-(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.
- (interactive)
- (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.
(print-level (or edebug-print-level print-level))
(print-circle (or edebug-print-circle print-circle))
(print-readably nil)) ;; lemacs uses this.
- (edebug-prin1-to-string value)))
+ (condition-case nil
+ (edebug-prin1-to-string value)
+ (error "#Apparently circular structure#"))))
(defun edebug-compute-previous-result (edebug-previous-value)
(if edebug-unwrap-results
;;; Read, Eval and Print
+(defalias 'edebug-prin1 'prin1)
+(defalias 'edebug-print 'print)
+(defalias 'edebug-prin1-to-string 'prin1-to-string)
+(defalias 'edebug-format 'format)
+(defalias 'edebug-message 'message)
+
(defun edebug-eval-expression (edebug-expr)
"Evaluate an expression in the outside environment.
If interactive, prompt for the expression.
specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode]
in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
-Also see bindings for the eval list buffer, *edebug*.
+Also see bindings for the eval list buffer *edebug* in `edebug-eval-mode'.
The edebug buffer commands:
\\{edebug-mode-map}
edebug-unwrap-results
edebug-global-break-condition
"
+ ;; If the user kills the buffer in which edebug is currently active,
+ ;; exit to top level, because the edebug command loop can't usefully
+ ;; continue running in such a case.
+ (add-hook 'kill-buffer-hook 'edebug-kill-buffer nil t)
(use-local-map edebug-mode-map))
+(defun edebug-kill-buffer ()
+ "Used on `kill-buffer-hook' when Edebug is operating in a buffer of Lisp code."
+ (let (kill-buffer-hook)
+ (kill-buffer (current-buffer)))
+ (top-level))
+
;;; edebug eval list mode
;; A list of expressions and their evaluations is displayed in *edebug*.
Eval list buffer commands:
\\{edebug-eval-mode-map}
-Global commands prefixed by global-edebug-prefix:
+Global commands prefixed by `global-edebug-prefix':
\\{global-edebug-map}")
;;; Interface with standard debugger.
(defun byte-compile-resolve-functions (funcs)
"Say it is OK for the named functions to be unresolved."
- (mapcar
+ (mapc
(function
(lambda (func)
(setq byte-compile-unresolved-functions