;;; edebug.el --- a source-level debugger for Emacs Lisp
-;; Copyright (C) 1988, 89, 90, 91, 92, 93, 94, 95, 97, 1999, 2000, 01, 2003
-;; 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,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Options
(defgroup edebug nil
- "A source-level debugger for Emacs Lisp"
+ "A source-level debugger for Emacs Lisp."
:group 'lisp)
;;;###autoload
(defcustom edebug-all-defs nil
- "*If non-nil, evaluation of any defining forms will instrument for Edebug.
+ "*If non-nil, evaluating defining forms instruments for Edebug.
This applies to `eval-defun', `eval-region', `eval-buffer', and
`eval-current-buffer'. `eval-region' is also called by
`eval-last-sexp', and `eval-print-last-sexp'.
:group 'edebug)
(defcustom edebug-initial-mode 'step
- "*Initial execution mode for Edebug, if non-nil. If this variable
-is non-@code{nil}, it specifies the initial execution mode for Edebug
-when it is first activated. Possible values are step, next, go,
-Go-nonstop, trace, Trace-fast, continue, and Continue-fast."
+ "*Initial execution mode for Edebug, if non-nil.
+If this variable is non-nil, it specifies the initial execution mode
+for Edebug when it is first activated. Possible values are step, next,
+go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast."
:type '(choice (const step) (const next) (const go)
(const Go-nonstop) (const trace)
(const Trace-fast) (const continue)
(defcustom edebug-print-length 50
- "*Default value of `print-length' to use while printing results in Edebug."
+ "*Default value of `print-length' for printing results in Edebug."
:type 'integer
:group 'edebug)
(defcustom edebug-print-level 50
- "*Default value of `print-level' to use while printing results in Edebug."
+ "*Default value of `print-level' for printing results in Edebug."
:type 'integer
:group 'edebug)
(defcustom edebug-print-circle t
- "*Default value of `print-circle' to use while printing results in Edebug."
+ "*Default value of `print-circle' for printing results in Edebug."
:type 'boolean
:group 'edebug)
;;; 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)
If the current defun is actually a call to `defvar', then reset the
variable using its initial value expression even if the variable
already has some other value. (Normally `defvar' does not change the
-variable's value if it already has a value.)
+variable's value if it already has a value.) Treat `defcustom'
+similarly. Reinitialize the face according to `defface' specification.
With a prefix argument, instrument the code for Edebug.
((and (eq (car form) 'defcustom)
(default-boundp (nth 1 form)))
;; Force variable to be bound.
- (set-default (nth 1 form) (eval (nth 2 form)))))
+ (set-default (nth 1 form) (eval (nth 2 form))))
+ ((eq (car form) 'defface)
+ ;; Reset the face.
+ (setq face-new-frame-defaults
+ (assq-delete-all (nth 1 form) face-new-frame-defaults))
+ (put (nth 1 form) 'face-defface-spec nil)
+ ;; See comments in `eval-defun-1' for purpose of code below
+ (setq form (prog1 `(prog1 ,form
+ (put ',(nth 1 form) 'saved-face
+ ',(get (nth 1 form) 'saved-face))
+ (put ',(nth 1 form) 'customized-face
+ ,(nth 2 form)))
+ (put (nth 1 form) 'saved-face nil)))))
(setq edebug-result (eval form))
(if (not edebugging)
(princ edebug-result)
;; 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)
(if (and (eq (following-char) ?.)
(save-excursion
(forward-char 1)
- (and (>= (following-char) ?0)
- (<= (following-char) ?9))))
+ (or (and (eq (aref edebug-read-syntax-table (following-char))
+ 'symbol)
+ (not (= (following-char) ?\;)))
+ (memq (following-char) '(?\, ?\.)))))
'symbol
(aref edebug-read-syntax-table (following-char))))
;; Leave point before the next token, skipping white space and comments.
(skip-chars-forward " \t\r\n\f")
(while (= (following-char) ?\;)
- ;; \r is counted as a comment terminator to support selective display.
- (skip-chars-forward "^\n\r") ; skip the comment
+ (skip-chars-forward "^\n") ; skip the comment
(skip-chars-forward " \t\r\n\f")))
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.
(def-edebug-spec push (form sexp))
(def-edebug-spec pop (sexp))
+(def-edebug-spec 1value (form))
+(def-edebug-spec noreturn (form))
+
+
;; Anything else?
;; Save the outside value of executing macro. (here??)
(edebug-outside-executing-macro executing-kbd-macro)
- (edebug-outside-pre-command-hook pre-command-hook)
- (edebug-outside-post-command-hook post-command-hook))
+ (edebug-outside-pre-command-hook
+ (edebug-var-status 'pre-command-hook))
+ (edebug-outside-post-command-hook
+ (edebug-var-status 'post-command-hook)))
(unwind-protect
(let (;; Don't keep reading from an executing kbd macro
;; within edebug unless edebug-continue-kbd-macro is
edebug-next-execution-mode nil)
(edebug-enter edebug-function edebug-args edebug-body))
;; Reset global variables in case outside value was changed.
- (setq executing-kbd-macro edebug-outside-executing-macro
- pre-command-hook edebug-outside-pre-command-hook
- post-command-hook edebug-outside-post-command-hook
- )))
+ (setq executing-kbd-macro edebug-outside-executing-macro)
+ (edebug-restore-status
+ 'post-command-hook edebug-outside-post-command-hook)
+ (edebug-restore-status
+ 'pre-command-hook edebug-outside-pre-command-hook)))
(let* ((edebug-data (get edebug-function 'edebug))
(edebug-def-mark (car edebug-data)) ; mark at def start
(funcall edebug-body))
)))
+(defun edebug-var-status (var)
+ "Return a cons cell describing the status of VAR's current binding.
+The purpose of this function is so you can properly undo
+subsequent changes to the same binding, by passing the status
+cons cell to `edebug-restore-status'. The status cons cell
+has the form (LOCUS . VALUE), where LOCUS can be a buffer
+\(for a buffer-local binding), a frame (for a frame-local binding),
+or nil (if the default binding is current)."
+ (cons (variable-binding-locus var)
+ (symbol-value var)))
+
+(defun edebug-restore-status (var status)
+ "Reset VAR based on STATUS.
+STATUS should be a list you got from `edebug-var-status'."
+ (let ((locus (car status))
+ (value (cdr status)))
+ (cond ((bufferp locus)
+ (if (buffer-live-p locus)
+ (with-current-buffer locus
+ (set var value))))
+ ((framep locus)
+ (modify-frame-parameters locus (list (cons var value))))
+ (t
+ (set var value)))))
(defun edebug-enter-trace (edebug-body)
(let ((edebug-stack-depth (1+ edebug-stack-depth))
(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.
(defun edebug-display ()
+ (unless (marker-position edebug-def-mark)
+ ;; The buffer holding the source has been killed.
+ ;; Let's at least show a backtrace so the user can figure out
+ ;; which function we're talking about.
+ (debug))
;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
;; Uses local variables of edebug-enter, edebug-before, edebug-after
;; and edebug-debugger.
(let ((edebug-active t) ; for minor mode alist
+ (edebug-with-timeout-suspend (with-timeout-suspend))
edebug-stop ; should we enter recursive-edit
(edebug-point (+ edebug-def-mark
(aref (nth 2 edebug-data) edebug-offset-index)))
(edebug-outside-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
(defun edebug-modify-breakpoint (flag &optional condition temporary)
- "Modify the breakpoint for the form at point or after it according
-to FLAG: set if t, clear if nil. Then move to that point.
+ "Modify the breakpoint for the form at point or after it.
+Set it if FLAG is non-nil, clear it otherwise. Then move to that point.
If CONDITION or TEMPORARY are non-nil, add those attributes to
the breakpoint. "
(let ((edebug-stop-point (edebug-find-stop-point)))
(defun edebug-set-global-break-condition (expression)
- (interactive (list (read-minibuffer
- "Global Condition: "
- (format "%s" edebug-global-break-condition))))
+ (interactive
+ (list
+ (let ((initial (and edebug-global-break-condition
+ (format "%s" edebug-global-break-condition))))
+ (read-from-minibuffer
+ "Global Condition: " initial read-expression-map t
+ (if (equal (car read-expression-history) initial)
+ '(read-expression-history . 1)
+ 'read-expression-history)))))
(setq edebug-global-break-condition expression))
(defun edebug-goto-here ()
- "Proceed to this stop point."
+ "Proceed to first stop-point at or after current position of point."
(interactive)
(edebug-go-mode t))
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)
(executing-kbd-macro edebug-outside-executing-macro)
(defining-kbd-macro edebug-outside-defining-kbd-macro)
- (pre-command-hook edebug-outside-pre-command-hook)
- (post-command-hook edebug-outside-post-command-hook)
+ ;; Get the values out of the saved statuses.
+ (pre-command-hook (cdr edebug-outside-pre-command-hook))
+ (post-command-hook (cdr edebug-outside-post-command-hook))
;; See edebug-display
(overlay-arrow-position edebug-outside-o-a-p)
(overlay-arrow-string edebug-outside-o-a-s)
(cursor-in-echo-area edebug-outside-c-i-e-a)
+ (default-cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
)
(unwind-protect
(save-excursion ; of edebug-buffer
edebug-outside-executing-macro executing-kbd-macro
edebug-outside-defining-kbd-macro defining-kbd-macro
- edebug-outside-pre-command-hook pre-command-hook
- edebug-outside-post-command-hook post-command-hook
edebug-outside-o-a-p overlay-arrow-position
edebug-outside-o-a-s overlay-arrow-string
edebug-outside-c-i-e-a cursor-in-echo-area
- ))) ; let
+ edebug-outside-d-c-i-n-s-w default-cursor-in-non-selected-windows
+ )
+
+ ;; Restore the outside saved values; don't alter
+ ;; the outside binding loci.
+ (setcdr edebug-outside-pre-command-hook pre-command-hook)
+ (setcdr edebug-outside-post-command-hook post-command-hook)
+
+ )) ; let
))
(defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
;;; 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
+ (setq edebug-previous-value
+ (edebug-unwrap* edebug-previous-value)))
(setq edebug-previous-result
- (if (and (integerp edebug-previous-value)
- (< edebug-previous-value 256)
- (>= edebug-previous-value 0))
- (format "Result: %s = %s" edebug-previous-value
- (single-key-description edebug-previous-value))
- (if edebug-unwrap-results
- (setq edebug-previous-value
- (edebug-unwrap* edebug-previous-value)))
- (concat "Result: "
- (edebug-safe-prin1-to-string edebug-previous-value)))))
+ (concat "Result: "
+ (edebug-safe-prin1-to-string edebug-previous-value)
+ (eval-expression-print-format edebug-previous-value))))
(defun edebug-previous-result ()
"Print the previous result."
;;; Read, Eval and Print
+(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.
(princ
(edebug-outside-excursion
(setq values (cons (edebug-eval edebug-expr) values))
- (edebug-safe-prin1-to-string (car values)))))
+ (concat (edebug-safe-prin1-to-string (car values))
+ (eval-expression-print-format (car values))))))
(defun edebug-eval-last-sexp ()
- "Evaluate sexp before point in the outside environment;
-print value in minibuffer."
+ "Evaluate sexp before point in the outside environment.
+Print value in minibuffer."
(interactive)
(edebug-eval-expression (edebug-last-sexp)))
(defun edebug-eval-print-last-sexp ()
- "Evaluate sexp before point in the outside environment;
-print value into current buffer."
+ "Evaluate sexp before point in outside environment; insert value.
+This prints the value into current buffer."
(interactive)
(let* ((edebug-form (edebug-last-sexp))
(edebug-result-string
;;; Edebug Minor Mode
-;; Global GUD bindings for all emacs-lisp-mode buffers.
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
+(defvar gud-inhibit-global-bindings
+ "*Non-nil means don't do global rebindings of C-x C-a subcommands.")
+;; Global GUD bindings for all emacs-lisp-mode buffers.
+(unless gud-inhibit-global-bindings
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where))
(defvar edebug-mode-map
(let ((map (copy-keymap emacs-lisp-mode-map)))
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*.
(defvar edebug-eval-mode-map nil
"Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
-(if edebug-eval-mode-map
- nil
- (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
+(unless edebug-eval-mode-map
+ (setq edebug-eval-mode-map (make-sparse-keymap))
+ (set-keymap-parent edebug-eval-mode-map lisp-interaction-mode-map)
(define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
(define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
(define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
(define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
- (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)
- )
+ (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp))
(put 'edebug-eval-mode 'mode-class 'special)
-(defun edebug-eval-mode ()
+(define-derived-mode edebug-eval-mode lisp-interaction-mode "Edebug Eval"
"Mode for evaluation list buffer while in Edebug.
In addition to all Interactive Emacs Lisp commands there are local and
Eval list buffer commands:
\\{edebug-eval-mode-map}
-Global commands prefixed by global-edebug-prefix:
-\\{global-edebug-map}
-"
- (lisp-interaction-mode)
- (setq major-mode 'edebug-eval-mode)
- (setq mode-name "Edebug Eval")
- (use-local-map edebug-eval-mode-map))
+Global commands prefixed by `global-edebug-prefix':
+\\{global-edebug-map}")
;;; Interface with standard debugger.
;;; Frequency count and coverage
(defun edebug-display-freq-count ()
- "Display the frequency count data for each line of the current
-definition. The frequency counts are inserted as comment lines after
+ "Display the frequency count data for each line of the current definition.
+The frequency counts are inserted as comment lines after
each line, and you can undo all insertions with one `undo' command.
The counts are inserted starting under the `(' before an expression
(- (current-column)
(if (= ?\( (following-char)) 0 1)))))
(insert (make-string
- (max 0 (- col (- (point) start-of-count-line))) ?\ )
+ (max 0 (- col (- (point) start-of-count-line))) ?\s)
(if (and (< 0 count)
(not (memq coverage
'(unknown ok-coverage))))
(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?
+ (mark t))
(defun edebug-set-conditional-breakpoint (arg condition)
"Set a conditional breakpoint at nearest sexp.
(interactive
(list
current-prefix-arg
-;; Read condition as follows; getting previous condition is cumbersome:
+ ;; 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))
(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)
- ))))))
+ (initial (and edebug-break-condition
+ (format "%s" edebug-break-condition))))
+ (read-from-minibuffer
+ "Condition: " initial read-expression-map t
+ (if (equal (car read-expression-history) initial)
+ '(read-expression-history . 1)
+ 'read-expression-history)))))))
(edebug-modify-breakpoint t condition arg))
-;;; The default for all above is Emacs.
-
-;; Epoch specific code was in a separate file: edebug-epoch.el.
-
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
\f
;;; Byte-compiler
(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