xemacs-beta: lisp/edebug/edebug.el comparison

comparison lisp/edebug/edebug.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	56c54cf7c5b6
children	b9518feda344

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94,'95 Free Software Foundation, Inc
 ;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
 ;; Keywords: lisp, tools, maint
-;; This file is part of XEmacs.
-;; XEmacs 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.
-;; XEmacs is distributed in the hope that it will be useful, 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
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-;;; Synched up with: FSF 19.34.
-;;; Commentary:
 ;; LCD Archive Entry:
 ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
 ;; |A source level debugger for Emacs Lisp.
-;; |$Date: 1997/08/21 06:23:41 $|$Revision: 1.3 $|~/modes/edebug.el|
+;; |$Date: 1996/12/18 22:43:07 $|$Revision: 1.1.1.1 $|~/modes/edebug.el|
-;; This minor mode allows programmers to step through Emacs Lisp
+;; This file is part of GNU Emacs.
-;; source code while executing functions.  You can also set
-;; breakpoints, trace (stopping at each expression), evaluate
+;; GNU Emacs is free software; you can redistribute it and/or modify
-;; expressions as if outside Edebug, reevaluate and display a list of
+;; it under the terms of the GNU General Public License as published by
-;; expressions, trap errors normally caught by debug, and display a
+;; the Free Software Foundation; either version 2, or (at your option)
-;; debug style backtrace.
+;; any later version.
-;;; Installation
+;; GNU Emacs is distributed in the hope that it will be useful,
-;; =============
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; Put edebug.el in some directory in your load-path and
+;; GNU General Public License for more details.
-;; byte-compile it.  Also read the beginning of edebug-epoch.el,
-;; cl-specs.el, and edebug-cl-read.el if they apply to you.
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; Unless you are using Emacs 19 which is already set up to use Edebug,
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-;; put the following forms in your .emacs file.
-;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
+;;;; Commentary:
-;; (autoload 'edebug-eval-top-level-form "edebug")
+;;; This minor mode allows programmers to step through Emacs Lisp
-;; If you wish to change the default edebug global command prefix, change:
+;;; source code while executing functions.  You can also set
-;; (setq edebug-global-prefix "\C-xX")
+;;; breakpoints, trace (stopping at each expression), evaluate
+;;; expressions as if outside Edebug, reevaluate and display a list of
-;; Other options, are described in the manual.
+;;; expressions, trap errors normally caught by debug, and display a
+;;; debug style backtrace.
-;; In previous versions of Edebug, users were directed to set
-;; `debugger' to `edebug-debug'.  This is no longer necessary
+;;;; Installation
-;; since Edebug automatically sets it whenever Edebug is active.
+;;; =============
-;;; Minimal Instructions
+;;; 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.
-;; First evaluate a defun with C-xx, then run the function.  Step
-;; through the code with SPC, mark breakpoints with b, go until a
+;;; Unless you are using Emacs 19 which is already set up to use Edebug,
-;; breakpoint is reached with g, and quit execution with q.  Use the
+;;; put the following forms in your .emacs file.
-;; "?" command in edebug to describe other commands.  See edebug.tex
+;;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
-;; or the Emacs 19 Lisp Reference Manual for more instructions.
+;;; (autoload 'edebug-eval-top-level-form "edebug")
-;; Send me your enhancements, ideas, bugs, or fixes.
+;;; If you wish to change the default edebug global command prefix, change:
-;; For bugs, you can call edebug-submit-bug-report if you have reporter.el.
+;;; (setq edebug-global-prefix "\C-xX")
-;; There is an edebug mailing list if you want to keep up
-;; with the latest developments. Requests to: edebug-request@cs.uiuc.edu
+;;; Other options, are described in the manual.
-;; Daniel LaLiberte   217-398-4114
+;;; In previous versions of Edebug, users were directed to set
-;; University of Illinois, Urbana-Champaign
+;;; `debugger' to `edebug-debug'.  This is no longer necessary
-;; Department of Computer Science
+;;; since Edebug automatically sets it whenever Edebug is active.
-;; 1304 W Springfield
-;; Urbana, IL  61801
+;;;; Minimal Instructions
+;;; =====================
-;; uiucdcs!liberte
-;; liberte@cs.uiuc.edu
+;;; First evaluate a defun with C-xx, then run the function.  Step
+;;; through the code with SPC, mark breakpoints with b, go until a
-;; For the early revision history, see edebug-history.
+;;; breakpoint is reached with g, and quit execution with q.  Use the
+;;; "?" command in edebug to describe other commands.  See edebug.tex
-;;; Code:
+;;; 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.
 (defconst edebug-version
-(let ((raw-version "$Revision: 1.3 $"))
+(let ((raw-version "$Revision: 1.1.1.1 $"))
 (substring raw-version (string-match "[0-9.]*" raw-version)
 	       (match-end 0))))
 (require 'backquote)
-;; Emacs 18 doesn't have defalias.
+;; Emacs 18 doesnt have defalias.
 (eval-and-compile
 (or (fboundp 'defalias) (fset 'defalias 'fset)))
-;;; Bug reporting
+;;;; Bug reporting
+;;; ==============
 (defconst edebug-maintainer-address "liberte@cs.uiuc.edu")
 (defun edebug-submit-bug-report ()
 "Submit, via mail, a bug report on edebug."
 'edebug-print-length
 'edebug-print-level
 'edebug-print-circle
 	       ))))
-;;; Options
+;;;; Options
+;;; ===============================
 (defvar edebug-setup-hook nil
 "*Functions to call before edebug is used.
 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
 (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.")
-;;; Form spec utilities.
+;;;; 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
 ;; (edebug-trace "indirection: %s" edebug-form-spec)
 (setq edebug-form-spec indirect))
 edebug-form-spec
 ))
-;;; Utilities
+;;;; Utilities
+;;; ===============================
 ;; Define edebug-gensym - from old cl.el
 (defvar edebug-gensym-index 0
 "Integer used by `edebug-gensym' to produce new names.")
 (point))
 (point)))))
 (defun edebug-window-list ()
 "Return a list of windows, in order of `next-window'."
-;; This doesn't work for epoch.
+;; This doesnt work for epoch.
 (let* ((first-window (selected-window))
 	 (window-list (list first-window))
 	 (next (next-window first-window)))
 (while (not (eq next first-window))
 (setq window-list (cons next window-list))
 (defun edebug-functionp (object)
 "Returns the function named by OBJECT, or nil if it is not a function."
 (setq object (edebug-lookup-function object))
 (if (or (subrp object)
-	  (compiled-function-p object) ; XEmacs
+	  (byte-code-function-p object)
 	  (and (listp object)
 	       (eq (car object) 'lambda)
 	       (listp (car (cdr object)))))
 object))
 	   (progn (,@ body))
 	 (save-excursion
 	   (set-buffer (marker-buffer edebug:s-r-beg))
 	   (narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
-;;; Display
+;;;; Display
+;;; ============
 (defconst edebug-trace-buffer "*edebug-trace*"
 "Name of the buffer to put trace info in.")
 (defun edebug-pop-to-buffer (buffer &optional window)
 (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
+	;; Dont select trace window
 	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.
 (defalias 'edebug-get-buffer-window 'get-buffer-window)
 (defalias 'edebug-sit-for 'sit-for)
 (defalias 'edebug-input-pending-p 'input-pending-p)
-;;; Redefine read and eval functions
+;;;; 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.
+;;; read is redefined to maybe instrument forms.
+;;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
-;; Use the Lisp version of eval-region.
+;;; Use the Lisp version of eval-region.
 (require 'eval-reg "eval-reg")
 ;; Save the original read function
 (or (fboundp 'edebug-original-read)
 (defalias 'edebug-original-read  (symbol-function 'read)))
 call it with a char as argument to push a char back)
 a string (takes text from string, starting at the beginning)
 t (read text line using minibuffer and use it).
 This version, from Edebug, maybe instruments the expression. But the
-STREAM must be the current buffer to do so.  Whether it instruments is
+STREAM must be the current buffer to do so.  Whether it instuments is
 also dependent on the values of `edebug-all-defs' and
 `edebug-all-forms'."
 (or stream (setq stream standard-input))
 (if (eq stream (current-buffer))
 (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)))
-;; We should somehow arrange to be able to do this
-;; without actually replacing the eval-defun command.
 (defun edebug-eval-defun (edebug-it)
 "Evaluate the top-level form containing point, or after point.
 This version, from Edebug, has the following differences: With a
 prefix argument instrument the code for Edebug.  If `edebug-all-defs' is
 non-nil, then the code is instrumented *unless* there is a prefix
 argument.  If instrumenting, it prints: `Edebug: FUNCTIONNAME'.
 Otherwise, it prints in the minibuffer."
 (interactive "P")
-(let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
+(let ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
-	 (edebug-result)
+	(edebug-result))
-	 (form
+(setq edebug-result
-	  (let ((edebug-all-forms edebugging)
+	  (eval
-		(edebug-all-defs (eq edebug-all-defs (not edebug-it))))
+	   (let ((edebug-all-forms edebugging)
-	    (edebug-read-top-level-form))))
+		 (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
-(if (and (eq (car form) 'defvar)
+	     (edebug-read-top-level-form))))
-	     (cdr-safe (cdr-safe form)))
-	(setq form (cons 'defconst (cdr form))))
-(setq edebug-result (eval form))
 (if (not edebugging)
 	(princ edebug-result)
 edebug-result)))
 This is like `eval-defun', but the code is always instrumented for Edebug.
 Print its name in the minibuffer and leave point where it is,
 or if an error occurs, leave point after it with mark at the original point."
 (interactive)
 (eval
-;; Bind edebug-all-forms only while reading, not while evalling
+;; Bind edebug-all-forms only while reading, not while evaling
 ;; but this causes problems while edebugging edebug.
 (let ((edebug-all-forms t)
 	 (edebug-all-defs t))
 (edebug-read-top-level-form))))
 (elisp-eval-region-uninstall)
 (defalias 'read (symbol-function 'edebug-original-read))
 (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
-;;; Edebug internal data
+;;;; Edebug internal data
+;;; ===============================
-;; The internal data that is needed for edebugging is kept in the
-;; buffer-local variable `edebug-form-data'.
+;;; The internal data that is needed for edebugging is kept in the
+;;; buffer-local variable `edebug-form-data'.
 ;; XEmacs change?
 (defconst edebug-form-data nil)
 (make-variable-buffer-local 'edebug-form-data)
 	;;   (get (car entry) 'edebug-dependents))
 	;; (set-marker (nth 1 entry) nil)
 	;; (set-marker (nth 2 entry) nil)
 	(setq edebug-form-data (delq entry edebug-form-data)))))
-;;; Parser utilities
+;;;; Parser utilities
+;;; ===============================
 (defun edebug-syntax-error (&rest args)
 ;; Signal an invalid-read-syntax with ARGS.
 (signal 'invalid-read-syntax args))
 (aset table i 'space)
 (setq i (1+ i)))
 (aset table ?\( 'lparen)
 (aset table ?\) 'rparen)
 (aset table ?\' 'quote)
-(aset table ?\` 'backquote)
-(aset table ?\, 'comma)
 (aset table ?\" 'string)
 (aset table ?\? 'char)
 (aset table ?\[ 'lbracket)
 (aset table ?\] 'rbracket)
 (aset table ?\. 'dot)
 (aset table ?\# 'hash)
 ;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
-;; We don't care about any other chars since they won't be seen.
+;; We dont care about any other chars since they wont be seen.
 table))
 (defun edebug-next-token-class ()
 ;; Move to the next token and return its class.  We only care about
-;; lparen, rparen, dot, quote, backquote, comma, string, char, vector,
+;; lparen, rparen, dot, quote, string, char, vector, or symbol.
-;; or symbol.
 (edebug-skip-whitespace)
 (aref edebug-read-syntax-table (following-char)))
 (defun edebug-skip-whitespace ()
 			     (edebug-original-read (current-buffer))
 			   (if (/= (preceding-char) ?\")
 			       (forward-char -1))))
 ((eq class 'quote) (forward-char 1)
 (list 'quote (edebug-read-sexp)))
-((eq class 'backquote)
-(list '\` (edebug-read-sexp)))
-((eq class 'comma)
-(list '\, (edebug-read-sexp)))
 (t ; anything else, just read it.
 (edebug-original-read (current-buffer))))))
-;;; Offsets for reader
+;;;; Offsets for reader
+;;; ==============================
 ;; Define a structure to represent offset positions of expressions.
 ;; Each offset structure looks like: (before . after) for constituents,
 ;; or for structures that have elements: (before <subexpressions> . after)
 ;; where the <subexpressions> are the offset structures for subexpressions
 	   (edebug-store-before-offset (, point))
 	   (,@ body))
 (edebug-store-after-offset (point)))))
-;;; Reader for Emacs Lisp.
+;;;; Reader for Emacs Lisp.
+;;; ==========================================
 ;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.
 (defconst edebug-read-alist
 '((symbol . edebug-read-symbol)
 (lparen . edebug-read-list)
 (string . edebug-read-string)
 (quote . edebug-read-quote)
-(backquote . edebug-read-backquote)
-(comma . edebug-read-comma)
 (lbracket . edebug-read-vector)
 (hash . edebug-read-function)
 ))
 (defun edebug-read-storing-offsets (stream)
 (forward-char 1)
 (list
 (edebug-storing-offsets (point)  'quote)
 (edebug-read-storing-offsets stream)))
-(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)))))
 (defun edebug-read-function (stream)
 ;; Turn #'thing into (function thing)
 (forward-char 1)
 (if (/= ?\' (following-char)) (edebug-syntax-error "Bad char"))
 (forward-char 1)
 (defun edebug-read-list (stream)
 (forward-char 1)			; skip \(
 (prog1
 (let ((elements))
 	(while (not (memq (edebug-next-token-class) '(rparen dot)))
-	  (if (eq (edebug-next-token-class) 'backquote)
+	  (setq elements (cons (edebug-read-storing-offsets stream) elements)))
-	      (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))))
 	(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))
 	  (setq elements (cons (edebug-read-storing-offsets stream) elements)))
 	(apply 'vector (nreverse elements)))
 (forward-char 1)			; skip \]
 ))
-;;; Cursors for traversal of list and vector elements with offsets.
+;;;; Cursors for traversal of list and vector elements with offsets.
+;;;====================================================================
 (defvar edebug-dotted-spec nil)
 (defun edebug-new-cursor (expressions offsets)
 ;; Return a new cursor for EXPRESSIONS with OFFSETS.
 (let ((offset (edebug-top-offset cursor)))
 (while (consp offset)
 (setq offset (cdr offset)))
 offset))
-;;; The Parser
+;;;; The Parser
+;;; ===============================
-;; The top level function for parsing forms is
-;; edebug-read-and-maybe-wrap-form; it calls all the rest.  It checks the
+;;; The top level function for parsing forms is
-;; syntax a bit and leaves point at any error it finds, but otherwise
+;;; edebug-read-and-maybe-wrap-form; it calls all the rest.  It checks the
-;; should appear to work like eval-defun.
+;;; syntax a bit and leaves point at any error it finds, but otherwise
+;;; should appear to work like eval-defun.
-;; The basic plan is to surround each expression with a call to
-;; the edebug debugger together with indexes into a table of positions of
+;;; The basic plan is to surround each expression with a call to
-;; all expressions.  Thus an expression "exp" becomes:
+;;; the edebug debugger together with indexes into a table of positions of
+;;; all expressions.  Thus an expression "exp" becomes:
-;; (edebug-after (edebug-before 1) 2 exp)
+;;; (edebug-after (edebug-before 1) 2 exp)
-;; When this is evaluated, first point is moved to the beginning of
-;; exp at offset 1 of the current function.  The expression is
+;;; When this is evaluated, first point is moved to the beginning of
-;; evaluated, which may cause more edebug calls, and then point is
+;;; exp at offset 1 of the current function.  The expression is
-;; moved to offset 2 after the end of exp.
+;;; evaluated, which may cause more edebug calls, and then point is
+;;; moved to offset 2 after the end of exp.
-;; The highest level expressions of the function are wrapped in a call to
-;; edebug-enter, which supplies the function name and the actual
+;;; The highest level expressions of the function are wrapped in a call to
-;; arguments to the function.  See functions edebug-enter, edebug-before,
+;;; edebug-enter, which supplies the function name and the actual
-;; and edebug-after for more details.
+;;; arguments to the function.  See functions edebug-enter, edebug-before,
+;;; and edebug-after for more details.
 ;; Dynamically bound vars, left unbound, but globally declared.
 ;; This is to quiet the byte compiler.
 ;; Window data of the highest definition being wrapped.
 (setq edebug-setup-hook nil)
 (let (result
 	edebug-top-window-data
 	edebug-def-name;; make sure it is locally nil
-	;; I don't like these here!!
+	;; I dont like these here!!
 	edebug-&optional
 	edebug-&rest
 	edebug-gate
 	edebug-best-error
 	edebug-error-point
 (defun edebug-read-and-maybe-wrap-form1 ()
 (let (spec
 	def-kind
 	defining-form-p
 	def-name
-	;; These offset things don't belong here, but to support recursive
+	;; These offset things dont belong here, but to support recursive
 	;; calls to edebug-read, they need to be here.
 	edebug-offsets
 	edebug-offsets-stack
 	edebug-current-offset ; reset to nil
 	)
 	(or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
 (` (edebug-enter
 (quote (, edebug-def-name))
 (, (if edebug-inside-func
 	     (` (list (,@
-		       ;; Doesn't work with more than one def-body!!
+		       ;; Doesnt work with more than one def-body!!
 		       ;; But the list will just be reversed.
 		       (nreverse edebug-def-args))))
 	   'nil))
 (function (lambda () (,@ forms)))
 )))
 ;; 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,
-;; then don't call edebug-before.
+;; then dont call edebug-before.
 (list 'edebug-after
 	(list 'edebug-before before-index)
 	after-index form))
 (defun edebug-make-after-form (form after-index)
 		 (edebug-inc-offset (edebug-cursor-offsets new-cursor))))
 	      )))
 	 ((symbolp form)
 	  (cond
-	   ;; Check for constant symbols that don't get wrapped.
+	   ;; Check for constant symbols that dont get wrapped.
 	   ((or (memq form '(t nil))
 		(and (fboundp 'edebug-keywordp) (edebug-keywordp form)))
 	    form)
 	   ;; This option may go away.
 (t (edebug-syntax-error
 	 "Head of list form must be a symbol or lambda expression.")))
 ))
-;;; Matching of specs.
+;;;; Matching of specs.
+;;; ===================
 (defvar edebug-after-dotted-spec nil)
 (defvar edebug-matching-depth 0)  ;; initial value
 (defconst edebug-max-depth 150)  ;; maximum number of matching recursions.
-;;; Failure to match
+;;;; Failure to match
+;;; ==================
 ;; This throws to no-match, if there are higher alternatives.
 ;; Otherwise it signals an error.  The place of the error is found
 ;; with the two before- and after-offset functions.
 (defun edebug-no-match (cursor &rest edebug-args)
 	   (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.
-;; Perhaps we shouldn't be doing this with edebug-form-specs since the
+;; Perhaps we shouldnt be doing this with edebug-form-specs since the
 ;; user may want to define macros or functions with the same names.
 ;; We could use an internal obarray for these primitive specs.
 (mapcar
 (function (lambda (pair)
 	(catch 'no-match
 	  (throw 'matched
 		 (let (edebug-gate ;; only while matching each spec
 		       edebug-best-error
 		       edebug-error-point)
-		   ;; Doesn't support e.g. &or symbolp &rest form
+		   ;; Doesnt support e.g. &or symbolp &rest form
 		   (edebug-match-one-spec cursor (car specs)))))
 	;; Match failed, so reset and try again.
 	(setq specs (cdr specs))
 	;; Reset the cursor for the next match.
 	(edebug-set-cursor cursor this-form this-offset))
 (def-edebug-spec &key edebug-match-&key)
 (defun edebug-match-&key (cursor specs)
 ;; Following specs must look like (<name> <spec>) ...
 ;; where <name> is the name of a keyword, and spec is its spec.
-;; This really doesn't save much over the expanded form and takes time.
+;; This really doesnt save much over the expanded form and takes time.
 (edebug-match-&rest
 cursor
 (cons '&or
 	 (mapcar (function (lambda (pair)
 			     (vector (format ":%s" (car pair))
 (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.
-;; Normally, &define is interpreted specially other places.
+;; Normally, &define is interpretted specially other places.
 ;; This should only be called inside of a spec list to match the remainder
 ;; of the current list.  e.g. ("lambda" &define args def-body)
 (edebug-make-form-wrapper
 cursor
 (edebug-before-offset cursor)
 edebug-spec-p  ;; Including all the special ones e.g. form.
 symbolp;; a predicate
 ))
-;;;* Emacs special forms and some functions.
+;;;;* Emacs special forms and some functions.
 ;; quote expects only one argument, although it allows any number.
 (def-edebug-spec quote sexp)
 ;; The standard defining forms.
 	   [&optional ("interactive" interactive)]
 	   def-body))
 (def-edebug-spec defmacro
 (&define name lambda-list def-body))
-(def-edebug-spec arglist lambda-list)  ;; deprecated - use lambda-list.
+(def-edebug-spec arglist lambda-list)  ;; denegrated - use lambda-list.
 (def-edebug-spec lambda-list
 (([&rest arg]
 [&optional ["&optional" arg &rest arg]]
 &optional ["&rest" arg]
 (def-edebug-spec eval-and-compile t)
 ;; Anything else?
+;;====================
 ;; Some miscellaneous specs for macros in public packages.
 ;; Send me yours.
 ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
 	    )
 	   [&optional stringp]
 	   [&optional ("interactive" interactive)]
 	   def-body))
-;;; The debugger itself
+;;;; The debugger itself
+;;; ===============================
 (defvar edebug-active nil)  ;; Non-nil when edebug is active
 ;;; add minor-mode-alist entry
 (or (assq 'edebug-active minor-mode-alist)
 (defvar post-command-idle-hook nil)
 (defvar cl-lexical-debug)  ;; Defined in cl.el
 ;;; Handling signals
+;;; =================
 (if (not (fboundp 'edebug-original-signal))
 (defalias 'edebug-original-signal (symbol-function 'signal)))
 ;; We should use advise for this!!
 ;; i.e. the signal is not continuable, yet.
 (edebug-original-signal edebug-signal-name edebug-signal-data))
 ;;; Entering Edebug
+;;; ==================
 (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.
 	    ;; Lexical bindings must be uncompiled for this to work.
 	    (cl-lexical-debug t)
 	    ;; Save the outside value of executing macro.  (here??)
-	    (edebug-outside-executing-macro executing-kbd-macro)
+	    (edebug-outside-executing-macro executing-macro)
 	    (edebug-outside-pre-command-hook pre-command-hook)
 	    (edebug-outside-post-command-hook post-command-hook)
 	    (edebug-outside-post-command-idle-hook post-command-idle-hook))
 	(unwind-protect
 	    (let (;; Don't keep reading from an executing kbd macro
 		  ;; within edebug unless edebug-continue-kbd-macro is
 		  ;; non-nil.  Again, local binding may not be best.
-		  (executing-kbd-macro
+		  (executing-macro
-		   (if edebug-continue-kbd-macro executing-kbd-macro))
+		   (if edebug-continue-kbd-macro executing-macro))
 		  ;; 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)
 	      (fset 'signal 'edebug-signal)
 	      (unwind-protect
 		  (edebug-enter edebug-function edebug-args edebug-body)
 		(fset 'signal (symbol-function 'edebug-original-signal))))
 	  ;; Reset global variables in case outside value was changed.
-	  (setq executing-kbd-macro edebug-outside-executing-macro
+	  (setq executing-macro edebug-outside-executing-macro
 		pre-command-hook edebug-outside-pre-command-hook
 		post-command-hook edebug-outside-post-command-hook
 		post-command-idle-hook edebug-outside-post-command-idle-hook
 		)))
 	  (if edebug-save-displayed-buffer-points
 	      (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
 	  ;; First move the edebug buffer point to edebug-point
-	  ;; so that window start doesn't get changed when we display it.
+	  ;; so that window start doesnt get changed when we display it.
-	  ;; I don't know if this is going to help.
+	  ;; I dont know if this is going to help.
 	  ;;(set-buffer edebug-buffer)
 	  ;;(goto-char edebug-point)
 	  ;; If edebug-buffer is not currently displayed,
 	  ;; first find a window for it.
 	      (if (or edebug-stop
 		      (memq edebug-execution-mode '(step next))
 		      (eq edebug-arg-mode 'error))
 		  (progn
 		    ;; (setq edebug-execution-mode 'step)
-		    ;; (edebug-overlay-arrow)	; this doesn't always show up.
+		    ;; (edebug-overlay-arrow)	; this doesnt always show up.
 		    (edebug-recursive-edit))) ; <---------- Recursive edit
 	    ;; Reset the edebug-window-data to whatever it is now.
 	    (let ((window (if (eq (window-buffer) edebug-buffer)
 			      (selected-window)
 			(progn
 			  (set-window-start window (cdr edebug-window-data)
 					    'no-force)
 			  ;; Unrestore edebug-buffer's window-point.
 			  ;; Needed in addition to setting the buffer point
-			  ;; - otherwise quitting doesn't leave point as is.
+			  ;; - otherwise quitting doesnt leave point as is.
 			  ;; But this causes point to not be restored at times.
 			  ;; Also, it may not be a visible window.
 			  ;; (set-window-point window edebug-point)
 			  )))
 	    ;; Restore current buffer always, in case application needs it.
 	    (set-buffer edebug-outside-buffer)
 	    ;; Restore point, and mark.
 	    ;; Needed even if restoring windows because
-	    ;; that doesn't restore point and mark in the current buffer.
+	    ;; that doesnt restore point and mark in the current buffer.
-	    ;; But don't restore point if edebug-buffer is current buffer.
+	    ;; But dont restore point if edebug-buffer is current buffer.
 	    (if (not (eq edebug-buffer edebug-outside-buffer))
 		(goto-char edebug-outside-point))
 	    (if (marker-buffer (edebug-mark-marker))
 		;; Does zmacs-regions need to be nil while doing set-marker?
 		(set-marker (edebug-mark-marker) edebug-outside-mark))
 ))
 ))
 ;;; Display related functions
+;;; ===============================
 (defun edebug-adjust-window (old-start)
 ;; If pos is not visible, adjust current window to fit following context.
 ;;;  (message "window: %s old-start: %s window-start: %s pos: %s"
 ;;;	   (selected-window) old-start (window-start) (point)) (sit-for 5)
 	      (delq buffer edebug-display-buffer-list)
 	    (cons buffer edebug-display-buffer-list)))
 (message "Displaying %s %s" buffer
 	     (if already-displaying "off" "on"))))
 ;;; Breakpoint related functions
+;;; ===============================
 (defun edebug-find-stop-point ()
 ;; Return (function . index) of the nearest edebug stop point.
 (let* ((edebug-def-name (edebug-form-data-symbol))
 	 (edebug-data
 		      ;; goto the first breakpoint
 		      (car edebug-breakpoints)))
 	      (goto-char (+ edebug-def-mark
 			    (aref offset-vector (car breakpoint))))
-	      (message "%s"
+	      (message (concat (if (nth 2 breakpoint)
-		       (concat (if (nth 2 breakpoint)
 				   "Temporary " "")
 			       (if (car (cdr breakpoint))
 				   (format "Condition: %s"
 					   (edebug-safe-prin1-to-string
 					    (car (cdr breakpoint))))
 		      (format "%s" edebug-global-break-condition))))
 (setq edebug-global-break-condition expression))
 ;;; Mode switching functions
+;;; ===============================
 (defun edebug-set-mode (mode shortmsg msg)
 ;; Set the edebug mode to MODE.
 ;; Display SHORTMSG, or MSG if not within edebug.
 (if (eq (1+ edebug-recursion-depth) (recursion-depth))
 ;;  "Go until the current function exits."
 ;;  (interactive)
 ;;  (edebug-set-mode 'exiting "Exit..."))
+;;; -----------------------------------------------------------------
 ;;; The following initial mode setting definitions are not used yet.
 '(defconst edebug-initial-mode-alist
 '((edebug-Continue-fast . Continue-fast)
 (edebug-Trace-fast . Trace-fast)
 	  (message "Initial mode for %s is now: %s"
 		   this-function mode))
 (error "Key must map to one of the mode changing commands")
 )))
 ;;; Evaluation of expressions
+;;; ===============================
 (def-edebug-spec edebug-outside-excursion t)
 (defmacro edebug-outside-excursion (&rest body)
 "Evaluate an expression list in the outside context.
 	     (last-nonmenu-event edebug-outside-last-nonmenu-event)
 	     (track-mouse edebug-outside-track-mouse)
 	     (standard-output edebug-outside-standard-output)
 	     (standard-input edebug-outside-standard-input)
-	     (executing-kbd-macro edebug-outside-executing-macro)
+	     (executing-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)
 	     (post-command-idle-hook edebug-outside-post-command-idle-hook)
 	    edebug-outside-last-nonmenu-event last-nonmenu-event
 	    edebug-outside-track-mouse track-mouse
 	    edebug-outside-standard-output standard-output
 	    edebug-outside-standard-input standard-input
-	    edebug-outside-executing-macro executing-kbd-macro
+	    edebug-outside-executing-macro executing-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-post-command-idle-hook post-command-idle-hook
 (edebug-eval edebug-expr)
 (error (edebug-format "%s: %s"  ;; could
 			  (get (car edebug-err) 'error-message)
 			  (car (cdr edebug-err))))))
-;;; Printing
+;;;; Printing
+;;; =========
 ;; Replace printing functions.
 ;; obsolete names
 (defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
 (defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
 	(print-readably nil)) ;; XEmacs uses this.
 (edebug-prin1-to-string value)))
 (defun edebug-compute-previous-result (edebug-previous-value)
 (setq edebug-previous-result
-	(if (numberp edebug-previous-value)
+	(if (and (numberp edebug-previous-value)
-	    (format "Result: %s" 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)))))
 (defun edebug-previous-result ()
 "Print the previous result."
 (interactive)
 (message "%s" edebug-previous-result))
-;;; Read, Eval and Print
+;;;; Read, Eval and Print
+;;; =====================
 (defun edebug-eval-expression (edebug-expr)
 "Evaluate an expression in the outside environment.
 If interactive, prompt for the expression.
 Print result in minibuffer."
 ;; princ the string to get rid of quotes.
 (princ edebug-result-string)
 (princ "\n")
 ))
-;;; Edebug Minor Mode
+;;;; 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)
 edebug-unwrap-results
 edebug-global-break-condition
 "
 (use-local-map edebug-mode-map))
-;;; edebug eval list mode
+;;;; edebug eval list mode
+;;; ===============================================
 ;; A list of expressions and their evaluations is displayed in *edebug*.
 (defun edebug-eval-result-list ()
 "Return a list of evaluations of edebug-eval-list"
 ;; Assumes in outside environment.
 (lisp-interaction-mode)
 (setq major-mode 'edebug-eval-mode)
 (setq mode-name "Edebug-Eval")
 (use-local-map edebug-eval-mode-map))
-;;; Interface with standard debugger.
+;;;; Interface with standard debugger.
+;;; ========================================
 ;; (setq debugger 'edebug) ; to use the edebug debugger
 ;; (setq debugger 'debug)  ; use the standard debugger
 ;; Note that debug and its utilities must be byte-compiled to work,
 	  (delete-region last-ok-point (point))
 	  )))
 )))))
-;;; Trace display
+;;;; Trace display
+;; ===============================
 (defun edebug-trace-display (buf-name fmt &rest args)
 "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
 The buffer is created if it does not exist.
 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))
-(let* ((oldbuf (current-buffer))
+(let* ((selected-window (selected-window))
-	 (selected-window (selected-window))
 	 (buffer (get-buffer-create buf-name))
 	 buf-window)
 ;;    (message "before pop-to-buffer") (sit-for 1)
 (edebug-pop-to-buffer buffer)
 (setq truncate-lines t)
 (set-window-start buf-window (point))
 (goto-char (point-max))
 ;;    (set-window-point buf-window (point))
 ;;    (edebug-sit-for 0)
 (bury-buffer buffer)
-(select-window selected-window)
+(select-window selected-window))
-(set-buffer oldbuf))
 buf-name)
 (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))
-;;; Frequency count and coverage
+;;;; Frequency count and coverage
+;;; ==============================
 (defun edebug-display-freq-count ()
 "Display the frequency count data for each line of the current
 definition.  The frequency counts are inserted as comment lines after
 each line, and you can undo all insertions with one `undo' command.
 (edebug-display-freq-count)
 (setq unread-command-char (read-char))
 (undo)))
-;;; Menus
+;;;; Menus
+;;;=========
 (defun edebug-toggle (variable)
 (set variable (not (eval variable)))
 (message "%s: %s" variable (eval variable)))
 (edebug-toggle 'edebug-save-displayed-buffer-points) t]
 ))
 "XEmacs style menus for Edebug.")
-;;; Emacs version specific code
+;;;; Emacs version specific code
+;;;=============================
 ;;; The default for all above is Emacs 18, because it is easier to compile
 ;;; Emacs 18 code in Emacs 19 than vice versa.  This default will
 ;;; change once most people are using Emacs 19 or derivatives.
 ;; Epoch specific code is in a separate file: edebug-epoch.el.
 ;; The byte-compiler will complain about changes in number of arguments
 ;; to functions like mark and read-from-minibuffer.  These warnings
 ;; may be ignored because the right call should always be made.
 (edebug-outside-excursion
 (setq values (cons (edebug-eval edebug-expr) values))
 (edebug-safe-prin1-to-string (car values)))))
 (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-(if (eq (console-type) 'x) ; XEmacs
+(if window-system
 (x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug])))
 )
 (defun edebug-xemacs-specific ()
 (edebug-emacs-19-specific))))
 (edebug-emacs-version-specific)
-;;; Byte-compiler
+;;;; Byte-compiler
+;;; ====================
 ;; 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.
 ;; XEmacs
 zmacs-deactivate-region
 popup-menu
 ;; CL
 cl-macroexpand-all
-;; And believe it or not, the byte compiler doesn't know about:
+;; And believe it or not, the byte compiler doesnt know about:
 byte-compile-resolve-functions
 ))
 '(byte-compile-resolve-free-references
 '(read-expression-history
 '(read-expression-history))
 )))
-;;; Autoloading of Edebug accessories
+;;;; Autoloading of Edebug accessories
+;;;===================================
 (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.
 ;; 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)))))
-;;; Finalize Loading
+;;;; Finalize Loading
+;;;===================
 ;;; 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)
 (provide 'edebug)
 ;;; edebug.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/edebug/edebug.el @ 70:131b0175ea99 r20-0b30