/[emacs]/emacs/lisp/emacs-lisp/edebug.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/edebug.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3.56 by monnier, Fri Sep 27 22:18:17 2002 UTC revision 3.57 by lektu, Tue Feb 4 12:53:34 2003 UTC
# Line 39  Line 39 
39  ;; First evaluate a defun with C-M-x, then run the function.  Step  ;; First evaluate a defun with C-M-x, then run the function.  Step
40  ;; through the code with SPC, mark breakpoints with b, go until a  ;; through the code with SPC, mark breakpoints with b, go until a
41  ;; breakpoint is reached with g, and quit execution with q.  Use the  ;; breakpoint is reached with g, and quit execution with q.  Use the
42  ;; "?" command in edebug to describe other commands.  ;; "?" command in edebug to describe other commands.
43  ;; See the Emacs Lisp Reference Manual for more details.  ;; See the Emacs Lisp Reference Manual for more details.
44    
45  ;; If you wish to change the default edebug global command prefix, change:  ;; If you wish to change the default edebug global command prefix, change:
# Line 105  Use the command `edebug-all-forms' to to Line 105  Use the command `edebug-all-forms' to to
105    :group 'edebug)    :group 'edebug)
106    
107  (defcustom edebug-eval-macro-args nil  (defcustom edebug-eval-macro-args nil
108    "*Non-nil means all macro call arguments may be evaluated.      "*Non-nil means all macro call arguments may be evaluated.
109  If this variable is nil, the default, Edebug will *not* wrap  If this variable is nil, the default, Edebug will *not* wrap
110  macro call arguments as if they will be evaluated.    macro call arguments as if they will be evaluated.
111  For each macro, a `edebug-form-spec' overrides this option.  For each macro, a `edebug-form-spec' overrides this option.
112  So to specify exceptions for macros that have some arguments evaluated  So to specify exceptions for macros that have some arguments evaluated
113  and some not, you should specify an `edebug-form-spec'."  and some not, you should specify an `edebug-form-spec'."
# Line 120  That takes some time, so if your program Line 120  That takes some time, so if your program
120  the window configurations, it is better to set this variable to nil.  the window configurations, it is better to set this variable to nil.
121    
122  If the value is a list, only the listed windows are saved and  If the value is a list, only the listed windows are saved and
123  restored.    restored.
124    
125  `edebug-toggle-save-windows' may be used to change this variable."  `edebug-toggle-save-windows' may be used to change this variable."
126    :type '(choice boolean (repeat string))    :type '(choice boolean (repeat string))
# Line 154  Go-nonstop, trace, Trace-fast, continue, Line 154  Go-nonstop, trace, Trace-fast, continue,
154  (defcustom edebug-trace nil  (defcustom edebug-trace nil
155    "*Non-nil means display a trace of function entry and exit.    "*Non-nil means display a trace of function entry and exit.
156  Tracing output is displayed in a buffer named `*edebug-trace*', one  Tracing output is displayed in a buffer named `*edebug-trace*', one
157  function entry or exit per line, indented by the recursion level.    function entry or exit per line, indented by the recursion level.
158    
159  You can customize by replacing functions `edebug-print-trace-before'  You can customize by replacing functions `edebug-print-trace-before'
160  and `edebug-print-trace-after'."  and `edebug-print-trace-after'."
# Line 316  A lambda list keyword is a symbol that s Line 316  A lambda list keyword is a symbol that s
316    (while (and (symbolp object) (fboundp object))    (while (and (symbolp object) (fboundp object))
317      (setq object (symbol-function object)))      (setq object (symbol-function object)))
318    object)    object)
319      
320  (defun edebug-macrop (object)  (defun edebug-macrop (object)
321    "Return the macro named by OBJECT, or nil if it is not a macro."    "Return the macro named by OBJECT, or nil if it is not a macro."
322    (setq object (edebug-lookup-function object))    (setq object (edebug-lookup-function object))
# Line 367  Return the result of the last expression Line 367  Return the result of the last expression
367    
368  (defun edebug-pop-to-buffer (buffer &optional window)  (defun edebug-pop-to-buffer (buffer &optional window)
369    ;; Like pop-to-buffer, but select window where BUFFER was last shown.    ;; Like pop-to-buffer, but select window where BUFFER was last shown.
370    ;; Select WINDOW if it provided and it still exists.  Otherwise,    ;; Select WINDOW if it provided and it still exists.  Otherwise,
371    ;; if buffer is currently shown in several windows, choose one.    ;; if buffer is currently shown in several windows, choose one.
372    ;; Otherwise, find a new window, possibly splitting one.    ;; Otherwise, find a new window, possibly splitting one.
373    (setq window (if (and (windowp window) (edebug-window-live-p window)    (setq window (if (and (windowp window) (edebug-window-live-p window)
# Line 430  Return the result of the last expression Line 430  Return the result of the last expression
430  (defun edebug-set-windows (window-info)  (defun edebug-set-windows (window-info)
431    ;; Set either a full window configuration or some window information.    ;; Set either a full window configuration or some window information.
432    (if (listp window-info)    (if (listp window-info)
433        (mapcar (function        (mapcar (function
434                 (lambda (one-window-info)                 (lambda (one-window-info)
435                   (if one-window-info                   (if one-window-info
436                       (apply (function                       (apply (function
437                               (lambda (window buffer point start hscroll)                               (lambda (window buffer point start hscroll)
438                                 (if (edebug-window-live-p window)                                 (if (edebug-window-live-p window)
439                                     (progn                                     (progn
# Line 573  already is one.)" Line 573  already is one.)"
573    "Toggle edebugging of all definitions."    "Toggle edebugging of all definitions."
574    (interactive)    (interactive)
575    (setq edebug-all-defs (not edebug-all-defs))    (setq edebug-all-defs (not edebug-all-defs))
576    (message "Edebugging all definitions is %s."    (message "Edebugging all definitions is %s."
577             (if edebug-all-defs "on" "off")))             (if edebug-all-defs "on" "off")))
578    
579    
# Line 581  already is one.)" Line 581  already is one.)"
581    "Toggle edebugging of all forms."    "Toggle edebugging of all forms."
582    (interactive)    (interactive)
583    (setq edebug-all-forms (not edebug-all-forms))    (setq edebug-all-forms (not edebug-all-forms))
584    (message "Edebugging all forms is %s."    (message "Edebugging all forms is %s."
585             (if edebug-all-forms "on" "off")))             (if edebug-all-forms "on" "off")))
586    
587    
# Line 601  already is one.)" Line 601  already is one.)"
601  ;;; Edebug internal data  ;;; Edebug internal data
602    
603  ;; The internal data that is needed for edebugging is kept in the  ;; The internal data that is needed for edebugging is kept in the
604  ;; buffer-local variable `edebug-form-data'.  ;; buffer-local variable `edebug-form-data'.
605    
606  (make-variable-buffer-local 'edebug-form-data)  (make-variable-buffer-local 'edebug-form-data)
607    
# Line 670  already is one.)" Line 670  already is one.)"
670    (setq edebug-form-data (cons new-entry edebug-form-data)))    (setq edebug-form-data (cons new-entry edebug-form-data)))
671    
672  (defun edebug-clear-form-data-entry (entry)  (defun edebug-clear-form-data-entry (entry)
673  ;; If non-nil, clear ENTRY out of the form data.    ;; If non-nil, clear ENTRY out of the form data.
674  ;; Maybe clear the markers and delete the symbol's edebug property?  ;; Maybe clear the markers and delete the symbol's edebug property?
675    (if entry    (if entry
676        (progn        (progn
677          ;; Instead of this, we could just find all contained forms.          ;; Instead of this, we could just find all contained forms.
678          ;; (put (car entry) 'edebug nil)   ;          ;; (put (car entry) 'edebug nil)   ;
679          ;; (mapcar 'edebug-clear-form-data-entry   ; dangerous          ;; (mapcar 'edebug-clear-form-data-entry   ; dangerous
680          ;;   (get (car entry) 'edebug-dependents))          ;;   (get (car entry) 'edebug-dependents))
681          ;; (set-marker (nth 1 entry) nil)          ;; (set-marker (nth 1 entry) nil)
# Line 806  already is one.)" Line 806  already is one.)"
806      ;; We just read a list after a dot, which will be abbreviated out.      ;; We just read a list after a dot, which will be abbreviated out.
807      (setq edebug-read-dotted-list nil)      (setq edebug-read-dotted-list nil)
808      ;; Drop the corresponding offset pair.      ;; Drop the corresponding offset pair.
809      ;; That is, nconc the reverse of the rest of the offsets      ;; That is, nconc the reverse of the rest of the offsets
810      ;; with the cdr of last offset.      ;; with the cdr of last offset.
811      (setcdr edebug-current-offset      (setcdr edebug-current-offset
812              (nconc (nreverse (cdr (cdr edebug-current-offset)))              (nconc (nreverse (cdr (cdr edebug-current-offset)))
# Line 827  already is one.)" Line 827  already is one.)"
827    
828  (defmacro edebug-storing-offsets (point &rest body)  (defmacro edebug-storing-offsets (point &rest body)
829    `(unwind-protect    `(unwind-protect
830         (progn         (progn
831           (edebug-store-before-offset ,point)           (edebug-store-before-offset ,point)
832           ,@body)           ,@body)
833       (edebug-store-after-offset (point))))       (edebug-store-after-offset (point))))
834    
835    
# Line 913  This controls how we read comma construc Line 913  This controls how we read comma construc
913    (forward-char 1)    (forward-char 1)
914    (cond ((eq ?\' (following-char))    (cond ((eq ?\' (following-char))
915           (forward-char 1)           (forward-char 1)
916           (list           (list
917            (edebug-storing-offsets (point)              (edebug-storing-offsets (point)
918              (if (featurep 'cl) 'function* 'function))              (if (featurep 'cl) 'function* 'function))
919            (edebug-read-storing-offsets stream)))            (edebug-read-storing-offsets stream)))
920          ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6          ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
# Line 925  This controls how we read comma construc Line 925  This controls how we read comma construc
925    
926  (defun edebug-read-list (stream)  (defun edebug-read-list (stream)
927    (forward-char 1)                      ; skip \(    (forward-char 1)                      ; skip \(
928    (prog1    (prog1
929        (let ((elements))        (let ((elements))
930          (while (not (memq (edebug-next-token-class) '(rparen dot)))          (while (not (memq (edebug-next-token-class) '(rparen dot)))
931            (if (eq (edebug-next-token-class) 'backquote)            (if (eq (edebug-next-token-class) 'backquote)
# Line 956  This controls how we read comma construc Line 956  This controls how we read comma construc
956    
957  (defun edebug-read-vector (stream)  (defun edebug-read-vector (stream)
958    (forward-char 1)                      ; skip \[    (forward-char 1)                      ; skip \[
959    (prog1    (prog1
960        (let ((elements))        (let ((elements))
961          (while (not (eq 'rbracket (edebug-next-token-class)))          (while (not (eq 'rbracket (edebug-next-token-class)))
962            (setq elements (cons (edebug-read-storing-offsets stream) elements)))            (setq elements (cons (edebug-read-storing-offsets stream) elements)))
# Line 970  This controls how we read comma construc Line 970  This controls how we read comma construc
970    
971  (defun edebug-new-cursor (expressions offsets)  (defun edebug-new-cursor (expressions offsets)
972    ;; Return a new cursor for EXPRESSIONS with OFFSETS.    ;; Return a new cursor for EXPRESSIONS with OFFSETS.
973    (if (vectorp expressions)    (if (vectorp expressions)
974        (setq expressions (append expressions nil)))        (setq expressions (append expressions nil)))
975    (cons expressions offsets))    (cons expressions offsets))
976    
# Line 1017  This controls how we read comma construc Line 1017  This controls how we read comma construc
1017    ;; This is a violation of the cursor encapsulation, but    ;; This is a violation of the cursor encapsulation, but
1018    ;; there is plenty of that going on while matching.    ;; there is plenty of that going on while matching.
1019    ;; The following test should always fail.    ;; The following test should always fail.
1020    (if (edebug-empty-cursor cursor)    (if (edebug-empty-cursor cursor)
1021        (edebug-no-match cursor "Not enough arguments."))        (edebug-no-match cursor "Not enough arguments."))
1022    (setcar cursor (cdr (car cursor)))    (setcar cursor (cdr (car cursor)))
1023    (setcdr cursor (cdr (cdr cursor)))    (setcdr cursor (cdr (cdr cursor)))
# Line 1027  This controls how we read comma construc Line 1027  This controls how we read comma construc
1027  (defun edebug-before-offset (cursor)  (defun edebug-before-offset (cursor)
1028    ;; Return the before offset of the cursor.    ;; Return the before offset of the cursor.
1029    ;; If there is nothing left in the offsets,    ;; If there is nothing left in the offsets,
1030    ;; return one less than the offset itself,    ;; return one less than the offset itself,
1031    ;; which is the after offset for a list.    ;; which is the after offset for a list.
1032    (let ((offset (edebug-cursor-offsets cursor)))    (let ((offset (edebug-cursor-offsets cursor)))
1033      (if (consp offset)      (if (consp offset)
# Line 1134  This controls how we read comma construc Line 1134  This controls how we read comma construc
1134                  defining-form-p (and (listp spec)                  defining-form-p (and (listp spec)
1135                                       (eq '&define (car spec)))                                       (eq '&define (car spec)))
1136                  ;; This is incorrect in general!! But OK most of the time.                  ;; This is incorrect in general!! But OK most of the time.
1137                  def-name (if (and defining-form-p                  def-name (if (and defining-form-p
1138                                    (eq 'name (car (cdr spec)))                                    (eq 'name (car (cdr spec)))
1139                                    (eq 'symbol (edebug-next-token-class)))                                    (eq 'symbol (edebug-next-token-class)))
1140                               (edebug-original-read (current-buffer))))))                               (edebug-original-read (current-buffer))))))
# Line 1144  This controls how we read comma construc Line 1144  This controls how we read comma construc
1144         (if (or edebug-all-defs edebug-all-forms)         (if (or edebug-all-defs edebug-all-forms)
1145             ;; If it is a defining form and we are edebugging defs,             ;; If it is a defining form and we are edebugging defs,
1146             ;; then let edebug-list-form start it.             ;; then let edebug-list-form start it.
1147             (let ((cursor (edebug-new-cursor             (let ((cursor (edebug-new-cursor
1148                            (list (edebug-read-storing-offsets (current-buffer)))                            (list (edebug-read-storing-offsets (current-buffer)))
1149                            (list edebug-offsets))))                            (list edebug-offsets))))
1150               (car               (car
1151                (edebug-make-form-wrapper                (edebug-make-form-wrapper
1152                 cursor                 cursor
1153                 (edebug-before-offset cursor)                 (edebug-before-offset cursor)
1154                 (1- (edebug-after-offset cursor))                 (1- (edebug-after-offset cursor))
1155                 (list (cons (symbol-name def-kind) (cdr spec))))))                 (list (cons (symbol-name def-kind) (cdr spec))))))
1156    
# Line 1159  This controls how we read comma construc Line 1159  This controls how we read comma construc
1159           ;; This only works for defs with simple names.           ;; This only works for defs with simple names.
1160           (put def-name 'edebug (point-marker))           (put def-name 'edebug (point-marker))
1161           ;; Also nil out dependent defs.           ;; Also nil out dependent defs.
1162           '(mapcar (function           '(mapcar (function
1163                     (lambda (def)                     (lambda (def)
1164                       (put def-name 'edebug nil)))                       (put def-name 'edebug nil)))
1165                    (get def-name 'edebug-dependents))                    (get def-name 'edebug-dependents))
# Line 1167  This controls how we read comma construc Line 1167  This controls how we read comma construc
1167    
1168       ;; If all forms are being edebugged, explicitly wrap it.       ;; If all forms are being edebugged, explicitly wrap it.
1169       (edebug-all-forms       (edebug-all-forms
1170        (let ((cursor (edebug-new-cursor        (let ((cursor (edebug-new-cursor
1171                       (list (edebug-read-storing-offsets (current-buffer)))                       (list (edebug-read-storing-offsets (current-buffer)))
1172                       (list edebug-offsets))))                       (list edebug-offsets))))
1173          (edebug-make-form-wrapper          (edebug-make-form-wrapper
1174           cursor           cursor
1175           (edebug-before-offset cursor)           (edebug-before-offset cursor)
1176           (edebug-after-offset cursor)           (edebug-after-offset cursor)
1177           nil)))           nil)))
1178    
1179       ;; Not a defining form, and not edebugging.       ;; Not a defining form, and not edebugging.
# Line 1207  This controls how we read comma construc Line 1207  This controls how we read comma construc
1207    ;; since it wraps the list of forms with a call to `edebug-enter'.    ;; since it wraps the list of forms with a call to `edebug-enter'.
1208    ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.    ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
1209    ;; Do this after parsing since that may find a name.    ;; Do this after parsing since that may find a name.
1210    (setq edebug-def-name    (setq edebug-def-name
1211          (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))          (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
1212    `(edebug-enter    `(edebug-enter
1213      (quote ,edebug-def-name)      (quote ,edebug-def-name)
1214      ,(if edebug-inside-func        ,(if edebug-inside-func
1215           `(list           `(list
1216             ;; Doesn't work with more than one def-body!!             ;; Doesn't work with more than one def-body!!
1217             ;; But the list will just be reversed.             ;; But the list will just be reversed.
# Line 1222  This controls how we read comma construc Line 1222  This controls how we read comma construc
1222    
1223    
1224  (defvar edebug-form-begin-marker) ; the mark for def being instrumented  (defvar edebug-form-begin-marker) ; the mark for def being instrumented
1225      
1226  (defvar edebug-offset-index) ; the next available offset index.  (defvar edebug-offset-index) ; the next available offset index.
1227  (defvar edebug-offset-list) ; the list of offset positions.  (defvar edebug-offset-list) ; the list of offset positions.
1228    
# Line 1238  This controls how we read comma construc Line 1238  This controls how we read comma construc
1238    
1239  (defun edebug-make-before-and-after-form (before-index form after-index)  (defun edebug-make-before-and-after-form (before-index form after-index)
1240    ;; Return the edebug form for the current function at offset BEFORE-INDEX    ;; Return the edebug form for the current function at offset BEFORE-INDEX
1241    ;; given FORM.  Looks like:    ;; given FORM.  Looks like:
1242    ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)    ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
1243    ;; Also increment the offset index for subsequent use.    ;; Also increment the offset index for subsequent use.
1244    (list 'edebug-after    (list 'edebug-after
1245          (list 'edebug-before before-index)          (list 'edebug-before before-index)
1246          after-index form))          after-index form))
1247    
# Line 1252  This controls how we read comma construc Line 1252  This controls how we read comma construc
1252    
1253  (defun edebug-unwrap (sexp)  (defun edebug-unwrap (sexp)
1254    "Return the unwrapped SEXP or return it as is if it is not wrapped.    "Return the unwrapped SEXP or return it as is if it is not wrapped.
1255  The SEXP might be the result of wrapping a body, which is a list of  The SEXP might be the result of wrapping a body, which is a list of
1256  expressions; a `progn' form will be returned enclosing these forms."  expressions; a `progn' form will be returned enclosing these forms."
1257    (if (consp sexp)    (if (consp sexp)
1258        (cond        (cond
1259         ((eq 'edebug-after (car sexp))         ((eq 'edebug-after (car sexp))
1260          (nth 3 sexp))          (nth 3 sexp))
1261         ((eq 'edebug-enter (car sexp))         ((eq 'edebug-enter (car sexp))
# Line 1285  expressions; a `progn' form will be retu Line 1285  expressions; a `progn' form will be retu
1285    ;; Skip the first offset.    ;; Skip the first offset.
1286    (edebug-set-cursor cursor (edebug-cursor-expressions cursor)    (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
1287                       (cdr (edebug-cursor-offsets cursor)))                       (cdr (edebug-cursor-offsets cursor)))
1288    (edebug-make-form-wrapper    (edebug-make-form-wrapper
1289     cursor     cursor
1290     form-begin (1- form-end)     form-begin (1- form-end)
1291     speclist))     speclist))
1292    
# Line 1298  expressions; a `progn' form will be retu Line 1298  expressions; a `progn' form will be retu
1298    ;; This is a hack, but I havent figured out a simpler way yet.    ;; This is a hack, but I havent figured out a simpler way yet.
1299    (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end))    (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end))
1300           ;; Set this marker before parsing.           ;; Set this marker before parsing.
1301           (edebug-form-begin-marker                       (edebug-form-begin-marker
1302            (if form-data-entry            (if form-data-entry
1303                (edebug-form-data-begin form-data-entry)                (edebug-form-data-begin form-data-entry)
1304              ;; Buffer must be current-buffer for this to work:              ;; Buffer must be current-buffer for this to work:
1305              (set-marker (make-marker) form-begin))))              (set-marker (make-marker) form-begin))))
# Line 1316  expressions; a `progn' form will be retu Line 1316  expressions; a `progn' form will be retu
1316            edebug-def-interactive            edebug-def-interactive
1317            edebug-inside-func;; whether wrapped code executes inside a function.            edebug-inside-func;; whether wrapped code executes inside a function.
1318            )            )
1319        
1320        (setq result        (setq result
1321              (if speclist              (if speclist
1322                  (edebug-match cursor speclist)                  (edebug-match cursor speclist)
1323    
1324                ;; else wrap as an enter-form.                ;; else wrap as an enter-form.
1325                (edebug-make-enter-wrapper (list (edebug-form cursor)))))                (edebug-make-enter-wrapper (list (edebug-form cursor)))))
1326        
1327        ;; Set the name here if it was not set by edebug-make-enter-wrapper.        ;; Set the name here if it was not set by edebug-make-enter-wrapper.
1328        (setq edebug-def-name        (setq edebug-def-name
1329              (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))              (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
1330    
1331        ;; Add this def as a dependent of containing def.  Buggy.        ;; Add this def as a dependent of containing def.  Buggy.
1332        '(if (and edebug-containing-def-name        '(if (and edebug-containing-def-name
1333                  (not (get edebug-containing-def-name 'edebug-dependents)))                  (not (get edebug-containing-def-name 'edebug-dependents)))
1334             (put edebug-containing-def-name 'edebug-dependents             (put edebug-containing-def-name 'edebug-dependents
1335                  (cons edebug-def-name                  (cons edebug-def-name
1336                        (get edebug-containing-def-name                        (get edebug-containing-def-name
1337                             'edebug-dependents))))                             'edebug-dependents))))
1338    
1339        ;; Create a form-data-entry or modify existing entry's markers.        ;; Create a form-data-entry or modify existing entry's markers.
1340        ;; In the latter case, pointers to the entry remain eq.        ;; In the latter case, pointers to the entry remain eq.
1341        (if (not form-data-entry)        (if (not form-data-entry)
1342            (setq form-data-entry            (setq form-data-entry
1343                  (edebug-make-form-data-entry                  (edebug-make-form-data-entry
1344                   edebug-def-name                   edebug-def-name
1345                   edebug-form-begin-marker                   edebug-form-begin-marker
1346                   ;; Buffer must be current-buffer.                   ;; Buffer must be current-buffer.
1347                   (set-marker (make-marker) form-end)                   (set-marker (make-marker) form-end)
1348                   ))                   ))
1349          (edebug-set-form-data-entry          (edebug-set-form-data-entry
1350           form-data-entry edebug-def-name ;; in case name is changed           form-data-entry edebug-def-name ;; in case name is changed
1351           form-begin form-end))           form-begin form-end))
1352    
# Line 1367  expressions; a `progn' form will be retu Line 1367  expressions; a `progn' form will be retu
1367            (let ((window ;; Find the best window for this buffer.            (let ((window ;; Find the best window for this buffer.
1368                   (or (get-buffer-window (current-buffer))                   (or (get-buffer-window (current-buffer))
1369                       (selected-window))))                       (selected-window))))
1370              (setq edebug-top-window-data              (setq edebug-top-window-data
1371                    (cons window (window-start window)))))                    (cons window (window-start window)))))
1372    
1373        ;; Store the edebug data in symbol's property list.        ;; Store the edebug data in symbol's property list.
# Line 1390  expressions; a `progn' form will be retu Line 1390  expressions; a `progn' form will be retu
1390    
1391    
1392  (defun edebug-clear-coverage (name)  (defun edebug-clear-coverage (name)
1393    ;; Create initial coverage vector.      ;; Create initial coverage vector.
1394    ;; Only need one per expression, but it is simpler to use stop points.    ;; Only need one per expression, but it is simpler to use stop points.
1395    (put name 'edebug-coverage    (put name 'edebug-coverage
1396         (make-vector (length edebug-offset-list) 'unknown)))         (make-vector (length edebug-offset-list) 'unknown)))
1397    
1398    
1399  (defun edebug-form (cursor)  (defun edebug-form (cursor)
1400    ;; Return the instrumented form for the following form.      ;; Return the instrumented form for the following form.
1401    ;; Add the point offsets to the edebug-offset-list for the form.    ;; Add the point offsets to the edebug-offset-list for the form.
1402    (let* ((form (edebug-top-element-required cursor "Expected form"))    (let* ((form (edebug-top-element-required cursor "Expected form"))
1403           (offset (edebug-top-offset cursor)))           (offset (edebug-top-offset cursor)))
# Line 1413  expressions; a `progn' form will be retu Line 1413  expressions; a `progn' form will be retu
1413                ;; Find out if this is a defining form from first symbol.                ;; Find out if this is a defining form from first symbol.
1414                ;; An indirect spec would not work here, yet.                ;; An indirect spec would not work here, yet.
1415                (if (and (consp spec) (eq '&define (car spec)))                (if (and (consp spec) (eq '&define (car spec)))
1416                    (edebug-defining-form                    (edebug-defining-form
1417                     new-cursor                     new-cursor
1418                     (car offset);; before the form                     (car offset);; before the form
1419                     (edebug-after-offset cursor)                     (edebug-after-offset cursor)
1420                     (cons (symbol-name head) (cdr spec)))                     (cons (symbol-name head) (cdr spec)))
1421                  ;; Wrap a regular form.                  ;; Wrap a regular form.
1422                  (edebug-make-before-and-after-form                  (edebug-make-before-and-after-form
1423                   (edebug-inc-offset (car offset))                   (edebug-inc-offset (car offset))
1424                   (edebug-list-form new-cursor)                   (edebug-list-form new-cursor)
1425                   ;; After processing the list form, the new-cursor is left                   ;; After processing the list form, the new-cursor is left
# Line 1496  expressions; a `progn' form will be retu Line 1496  expressions; a `progn' form will be retu
1496          (edebug-move-cursor cursor)          (edebug-move-cursor cursor)
1497          (edebug-interactive-p-name))          (edebug-interactive-p-name))
1498         (t         (t
1499          (cons head (edebug-list-form-args          (cons head (edebug-list-form-args
1500                      head (edebug-move-cursor cursor))))))                      head (edebug-move-cursor cursor))))))
1501    
1502       ((consp head)       ((consp head)
# Line 1518  expressions; a `progn' form will be retu Line 1518  expressions; a `progn' form will be retu
1518  (defconst edebug-max-depth 150)  ;; maximum number of matching recursions.  (defconst edebug-max-depth 150)  ;; maximum number of matching recursions.
1519    
1520    
1521  ;;; Failure to match  ;;; Failure to match
1522    
1523  ;; This throws to no-match, if there are higher alternatives.  ;; This throws to no-match, if there are higher alternatives.
1524  ;; Otherwise it signals an error.  The place of the error is found  ;; Otherwise it signals an error.  The place of the error is found
# Line 1563  expressions; a `progn' form will be retu Line 1563  expressions; a `progn' form will be retu
1563  (defun edebug-match-specs (cursor specs remainder-handler)  (defun edebug-match-specs (cursor specs remainder-handler)
1564    ;; Append results of matching the list of specs.    ;; Append results of matching the list of specs.
1565    ;; The first spec is handled and the remainder-handler handles the rest.    ;; The first spec is handled and the remainder-handler handles the rest.
1566    (let ((edebug-matching-depth    (let ((edebug-matching-depth
1567           (if (> edebug-matching-depth edebug-max-depth)           (if (> edebug-matching-depth edebug-max-depth)
1568               (error "too deep - perhaps infinite loop in spec?")               (error "too deep - perhaps infinite loop in spec?")
1569             (1+ edebug-matching-depth))))             (1+ edebug-matching-depth))))
1570      (cond      (cond
1571       ((null specs) nil)       ((null specs) nil)
1572      
1573       ;; Is the spec dotted?       ;; Is the spec dotted?
1574       ((atom specs)         ((atom specs)
1575        (let ((edebug-dotted-spec t));; Containing spec list was dotted.        (let ((edebug-dotted-spec t));; Containing spec list was dotted.
1576          (edebug-match-specs cursor (list specs) remainder-handler)))          (edebug-match-specs cursor (list specs) remainder-handler)))
1577    
# Line 1590  expressions; a `progn' form will be retu Line 1590  expressions; a `progn' form will be retu
1590    
1591       (t;; Process normally.       (t;; Process normally.
1592        (let* ((spec (car specs))        (let* ((spec (car specs))
1593               (rest)                     (rest)
1594               (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))               (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
1595          ;;(message "spec = %s  first char = %s" spec first-char) (sit-for 1)          ;;(message "spec = %s  first char = %s" spec first-char) (sit-for 1)
1596          (nconc          (nconc
# Line 1638  expressions; a `progn' form will be retu Line 1638  expressions; a `progn' form will be retu
1638    ;; Match a symbol spec.    ;; Match a symbol spec.
1639    (let* ((spec (get-edebug-spec symbol)))    (let* ((spec (get-edebug-spec symbol)))
1640      (cond      (cond
1641       (spec       (spec
1642        (if (consp spec)        (if (consp spec)
1643            ;; It is an indirect spec.            ;; It is an indirect spec.
1644            (edebug-match cursor spec)            (edebug-match cursor spec)
1645          ;; Otherwise it should be the symbol name of a function.          ;; Otherwise it should be the symbol name of a function.
1646          ;; There could be a bug here - maybe need to do edebug-match bindings.          ;; There could be a bug here - maybe need to do edebug-match bindings.
1647          (funcall spec cursor)))          (funcall spec cursor)))
1648              
1649       ((null symbol)  ;; special case this.       ((null symbol)  ;; special case this.
1650        (edebug-match-nil cursor))        (edebug-match-nil cursor))
1651    
1652       ((fboundp symbol)                  ; is it a predicate?       ((fboundp symbol)                  ; is it a predicate?
1653        (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))        (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
1654          ;; Special case for edebug-`.          ;; Special case for edebug-`.
1655          (if (and (listp sexp) (eq (car sexp) ',))          (if (and (listp sexp) (eq (car sexp) ',))
# Line 1700  expressions; a `progn' form will be retu Line 1700  expressions; a `progn' form will be retu
1700    (if (null specs) (setq specs edebug-&rest))    (if (null specs) (setq specs edebug-&rest))
1701    ;; Reuse the &optional handler with this as the remainder handler.    ;; Reuse the &optional handler with this as the remainder handler.
1702    (edebug-&optional-wrapper cursor specs remainder-handler))    (edebug-&optional-wrapper cursor specs remainder-handler))
1703      
1704  (defun edebug-match-&rest (cursor specs)  (defun edebug-match-&rest (cursor specs)
1705    ;; Repeatedly use specs until failure.    ;; Repeatedly use specs until failure.
1706    (let ((edebug-&rest specs) ;; remember these    (let ((edebug-&rest specs) ;; remember these
# Line 1745  expressions; a `progn' form will be retu Line 1745  expressions; a `progn' form will be retu
1745        (edebug-no-match cursor "Unexpected"))        (edebug-no-match cursor "Unexpected"))
1746    ;; This means nothing matched, so it is OK.    ;; This means nothing matched, so it is OK.
1747    nil) ;; So, return nothing    nil) ;; So, return nothing
1748      
1749    
1750  (def-edebug-spec &key edebug-match-&key)  (def-edebug-spec &key edebug-match-&key)
1751    
# Line 1753  expressions; a `progn' form will be retu Line 1753  expressions; a `progn' form will be retu
1753    ;; Following specs must look like (<name> <spec>) ...    ;; Following specs must look like (<name> <spec>) ...
1754    ;; where <name> is the name of a keyword, and spec is its spec.    ;; where <name> is the name of a keyword, and spec is its spec.
1755    ;; This really doesn't save much over the expanded form and takes time.    ;; This really doesn't save much over the expanded form and takes time.
1756    (edebug-match-&rest    (edebug-match-&rest
1757     cursor     cursor
1758     (cons '&or     (cons '&or
1759           (mapcar (function (lambda (pair)           (mapcar (function (lambda (pair)
1760                               (vector (format ":%s" (car pair))                               (vector (format ":%s" (car pair))
1761                                       (car (cdr pair)))))                                       (car (cdr pair)))))
1762                   specs))))                   specs))))
1763    
# Line 1771  expressions; a `progn' form will be retu Line 1771  expressions; a `progn' form will be retu
1771  (defun edebug-match-list (cursor specs)  (defun edebug-match-list (cursor specs)
1772    ;; The spec is a list, but what kind of list, and what context?    ;; The spec is a list, but what kind of list, and what context?
1773    (if edebug-dotted-spec    (if edebug-dotted-spec
1774        ;; After dotted spec but form did not contain dot,        ;; After dotted spec but form did not contain dot,
1775        ;; so match list spec elements as if spliced in.        ;; so match list spec elements as if spliced in.
1776        (prog1        (prog1
1777            (let ((edebug-dotted-spec))            (let ((edebug-dotted-spec))
# Line 1792  expressions; a `progn' form will be retu Line 1792  expressions; a `progn' form will be retu
1792              (edebug-move-cursor cursor)              (edebug-move-cursor cursor)
1793              (setq edebug-gate t)              (setq edebug-gate t)
1794              form)              form)
1795             (t             (t
1796              (error "Bad spec: %s" specs)))))              (error "Bad spec: %s" specs)))))
1797    
1798         ((listp form)         ((listp form)
1799          (prog1          (prog1
1800              (list (edebug-match-sublist              (list (edebug-match-sublist
1801                     ;; First offset is for the list form itself.                     ;; First offset is for the list form itself.
1802                     ;; Treat nil as empty list.                     ;; Treat nil as empty list.
1803                     (edebug-new-cursor form (cdr (edebug-top-offset cursor)))                     (edebug-new-cursor form (cdr (edebug-top-offset cursor)))
1804                     specs))                     specs))
1805            (edebug-move-cursor cursor)))            (edebug-move-cursor cursor)))
1806    
1807         ((and (eq 'vector spec) (vectorp form))         ((and (eq 'vector spec) (vectorp form))
1808          ;; Special case: match a vector with the specs.          ;; Special case: match a vector with the specs.
1809          (let ((result (edebug-match-sublist          (let ((result (edebug-match-sublist
1810                         (edebug-new-cursor                         (edebug-new-cursor
1811                          form (cdr (edebug-top-offset cursor)))                          form (cdr (edebug-top-offset cursor)))
1812                         (cdr specs))))                         (cdr specs))))
1813            (edebug-move-cursor cursor)            (edebug-move-cursor cursor)
1814            (list (apply 'vector result))))            (list (apply 'vector result))))
1815        
1816         (t (edebug-no-match cursor "Expected" specs)))         (t (edebug-no-match cursor "Expected" specs)))
1817        )))        )))
1818    
# Line 1823  expressions; a `progn' form will be retu Line 1823  expressions; a `progn' form will be retu
1823          ;;edebug-best-error          ;;edebug-best-error
1824          ;;edebug-error-point          ;;edebug-error-point
1825          )          )
1826      (prog1      (prog1
1827          ;; match with edebug-match-specs so edebug-best-error is not bound.          ;; match with edebug-match-specs so edebug-best-error is not bound.
1828          (edebug-match-specs cursor specs 'edebug-match-specs)          (edebug-match-specs cursor specs 'edebug-match-specs)
1829        (if (not (edebug-empty-cursor cursor))        (if (not (edebug-empty-cursor cursor))
1830            (if edebug-best-error            (if edebug-best-error
1831                (apply 'edebug-no-match cursor edebug-best-error)                (apply 'edebug-no-match cursor edebug-best-error)
1832              ;; A failed &rest or &optional spec may leave some args.              ;; A failed &rest or &optional spec may leave some args.
1833              (edebug-no-match cursor "Failed matching" specs)              (edebug-no-match cursor "Failed matching" specs)
# Line 1860  expressions; a `progn' form will be retu Line 1860  expressions; a `progn' form will be retu
1860    ;; This should only be called inside of a spec list to match the remainder    ;; This should only be called inside of a spec list to match the remainder
1861    ;; of the current list.  e.g. ("lambda" &define args def-body)    ;; of the current list.  e.g. ("lambda" &define args def-body)
1862     (edebug-make-form-wrapper     (edebug-make-form-wrapper
1863      cursor      cursor
1864      (edebug-before-offset cursor)      (edebug-before-offset cursor)
1865      ;; Find the last offset in the list.      ;; Find the last offset in the list.
1866      (let ((offsets (edebug-cursor-offsets cursor)))      (let ((offsets (edebug-cursor-offsets cursor)))
# Line 1872  expressions; a `progn' form will be retu Line 1872  expressions; a `progn' form will be retu
1872    ;; The expression must be a function.    ;; The expression must be a function.
1873    ;; This will match any list form that begins with a symbol    ;; This will match any list form that begins with a symbol
1874    ;; that has an edebug-form-spec beginning with &define.  In    ;; that has an edebug-form-spec beginning with &define.  In
1875    ;; practice, only lambda expressions should be used.      ;; practice, only lambda expressions should be used.
1876    ;; I could add a &lambda specification to avoid confusion.    ;; I could add a &lambda specification to avoid confusion.
1877    (let* ((sexp (edebug-top-element-required    (let* ((sexp (edebug-top-element-required
1878                  cursor "Expected lambda expression"))                  cursor "Expected lambda expression"))
1879           (offset (edebug-top-offset cursor))           (offset (edebug-top-offset cursor))
1880           (head (and (consp sexp) (car sexp)))           (head (and (consp sexp) (car sexp)))
# Line 1884  expressions; a `progn' form will be retu Line 1884  expressions; a `progn' form will be retu
1884      (if (and (consp spec) (eq '&define (car spec)))      (if (and (consp spec) (eq '&define (car spec)))
1885          (prog1          (prog1
1886              (list              (list
1887               (edebug-defining-form               (edebug-defining-form
1888                (edebug-new-cursor sexp offset)                (edebug-new-cursor sexp offset)
1889                (car offset);; before the sexp                (car offset);; before the sexp
1890                (edebug-after-offset cursor)                (edebug-after-offset cursor)
1891                (cons (symbol-name head) (cdr spec))))                (cons (symbol-name head) (cdr spec))))
1892            (edebug-move-cursor cursor))            (edebug-move-cursor cursor))
1893        (edebug-no-match cursor "Expected lambda expression")        (edebug-no-match cursor "Expected lambda expression")
# Line 2064  expressions; a `progn' form will be retu Line 2064  expressions; a `progn' form will be retu
2064    
2065  (def-edebug-spec \` (backquote-form))  (def-edebug-spec \` (backquote-form))
2066    
2067  ;; Supports quotes inside backquotes,  ;; Supports quotes inside backquotes,
2068  ;; but only at the top level inside unquotes.  ;; but only at the top level inside unquotes.
2069  (def-edebug-spec backquote-form  (def-edebug-spec backquote-form
2070    (&or    (&or
# Line 2130  expressions; a `progn' form will be retu Line 2130  expressions; a `progn' form will be retu
2130  ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)  ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
2131    
2132  (def-edebug-spec ad-dolist ((symbolp form &optional form) body))  (def-edebug-spec ad-dolist ((symbolp form &optional form) body))
2133  (def-edebug-spec defadvice  (def-edebug-spec defadvice
2134    (&define name   ;; thing being advised.    (&define name   ;; thing being advised.
2135             (name  ;; class is [&or "before" "around" "after"             (name  ;; class is [&or "before" "around" "after"
2136                    ;;               "activation" "deactivation"]                    ;;               "activation" "deactivation"]
2137              name  ;; name of advice              name  ;; name of advice
2138              &rest sexp  ;; optional position and flags              &rest sexp  ;; optional position and flags
2139              )              )
# Line 2241  error is signaled again." Line 2241  error is signaled again."
2241  (defun edebug-enter (edebug-function edebug-args edebug-body)  (defun edebug-enter (edebug-function edebug-args edebug-body)
2242    ;; Entering FUNC.  The arguments are ARGS, and the body is BODY.    ;; Entering FUNC.  The arguments are ARGS, and the body is BODY.
2243    ;; Setup edebug variables and evaluate BODY.  This function is called    ;; Setup edebug variables and evaluate BODY.  This function is called
2244    ;; when a function evaluated with edebug-eval-top-level-form is entered.      ;; when a function evaluated with edebug-eval-top-level-form is entered.
2245    ;; Return the result of BODY.    ;; Return the result of BODY.
2246    
2247    ;; Is this the first time we are entering edebug since    ;; Is this the first time we are entering edebug since
# Line 2249  error is signaled again." Line 2249  error is signaled again."
2249    ;; More precisely, this tests whether Edebug is currently active.    ;; More precisely, this tests whether Edebug is currently active.
2250    (if (not edebug-entered)    (if (not edebug-entered)
2251        (let ((edebug-entered t)        (let ((edebug-entered t)
2252              ;; Binding max-lisp-eval-depth here is OK,              ;; Binding max-lisp-eval-depth here is OK,
2253              ;; but not inside an unwind-protect.              ;; but not inside an unwind-protect.
2254              ;; Doing it here also keeps it from growing too large.              ;; Doing it here also keeps it from growing too large.
2255              (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??              (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
# Line 2278  error is signaled again." Line 2278  error is signaled again."
2278              (let (;; Don't keep reading from an executing kbd macro              (let (;; Don't keep reading from an executing kbd macro
2279                    ;; within edebug unless edebug-continue-kbd-macro is                    ;; within edebug unless edebug-continue-kbd-macro is
2280                    ;; non-nil.  Again, local binding may not be best.                    ;; non-nil.  Again, local binding may not be best.
2281                    (executing-kbd-macro                    (executing-kbd-macro
2282                     (if edebug-continue-kbd-macro executing-kbd-macro))                     (if edebug-continue-kbd-macro executing-kbd-macro))
2283    
2284                    ;; Don't get confused by the user's keymap changes.                    ;; Don't get confused by the user's keymap changes.
# Line 2292  error is signaled again." Line 2292  error is signaled again."
2292                    ;; This may be more than we need, however.                    ;; This may be more than we need, however.
2293                    (pre-command-hook nil)                    (pre-command-hook nil)
2294                    (post-command-hook nil))                    (post-command-hook nil))
2295                (setq edebug-execution-mode (or edebug-next-execution-mode                (setq edebug-execution-mode (or edebug-next-execution-mode
2296                                                edebug-initial-mode                                                edebug-initial-mode
2297                                                edebug-execution-mode)                                                edebug-execution-mode)
2298                      edebug-next-execution-mode nil)                      edebug-next-execution-mode nil)
2299                (edebug-enter edebug-function edebug-args edebug-body))                (edebug-enter edebug-function edebug-args edebug-body))
# Line 2302  error is signaled again." Line 2302  error is signaled again."
2302                  pre-command-hook edebug-outside-pre-command-hook                  pre-command-hook edebug-outside-pre-command-hook
2303                  post-command-hook edebug-outside-post-command-hook                  post-command-hook edebug-outside-post-command-hook
2304                  )))                  )))
2305        
2306      (let* ((edebug-data (get edebug-function 'edebug))      (let* ((edebug-data (get edebug-function 'edebug))
2307             (edebug-def-mark (car edebug-data)) ; mark at def start             (edebug-def-mark (car edebug-data)) ; mark at def start
2308             (edebug-freq-count (get edebug-function 'edebug-freq-count))             (edebug-freq-count (get edebug-function 'edebug-freq-count))
# Line 2326  error is signaled again." Line 2326  error is signaled again."
2326  (defun edebug-enter-trace (edebug-body)  (defun edebug-enter-trace (edebug-body)
2327    (let ((edebug-stack-depth (1+ edebug-stack-depth))    (let ((edebug-stack-depth (1+ edebug-stack-depth))
2328          edebug-result)          edebug-result)
2329      (edebug-print-trace-before      (edebug-print-trace-before
2330       (format "%s args: %s" edebug-function edebug-args))       (format "%s args: %s" edebug-function edebug-args))
2331      (prog1 (setq edebug-result (funcall edebug-body))      (prog1 (setq edebug-result (funcall edebug-body))
2332        (edebug-print-trace-after        (edebug-print-trace-after
# Line 2341  The result of BODY is also printed." Line 2341  The result of BODY is also printed."
2341           edebug-result)           edebug-result)
2342       (edebug-print-trace-before ,msg)       (edebug-print-trace-before ,msg)
2343       (prog1 (setq edebug-result (progn ,@body))       (prog1 (setq edebug-result (progn ,@body))
2344         (edebug-print-trace-after         (edebug-print-trace-after
2345          (format "%s result: %s" ,msg edebug-result)))))          (format "%s result: %s" ,msg edebug-result)))))
2346    
2347  (defun edebug-print-trace-before (msg)  (defun edebug-print-trace-before (msg)
# Line 2360  MSG is printed after `::::} '." Line 2360  MSG is printed after `::::} '."
2360    
2361  (defun edebug-slow-before (edebug-before-index)  (defun edebug-slow-before (edebug-before-index)
2362    ;; Debug current function given BEFORE position.    ;; Debug current function given BEFORE position.
2363    ;; Called from functions compiled with edebug-eval-top-level-form.      ;; Called from functions compiled with edebug-eval-top-level-form.
2364    ;; Return the before index.    ;; Return the before index.
2365    (setcar edebug-offset-indices edebug-before-index)    (setcar edebug-offset-indices edebug-before-index)
2366    
2367    ;; Increment frequency count    ;; Increment frequency count
2368    (aset edebug-freq-count edebug-before-index    (aset edebug-freq-count edebug-before-index
2369          (1+ (aref edebug-freq-count edebug-before-index)))          (1+ (aref edebug-freq-count edebug-before-index)))
2370    
# Line 2383  MSG is printed after `::::} '." Line 2383  MSG is printed after `::::} '."
2383    ;; Return VALUE.    ;; Return VALUE.
2384    (setcar edebug-offset-indices edebug-after-index)    (setcar edebug-offset-indices edebug-after-index)
2385    
2386    ;; Increment frequency count    ;; Increment frequency count
2387    (aset edebug-freq-count edebug-after-index    (aset edebug-freq-count edebug-after-index
2388          (1+ (aref edebug-freq-count edebug-after-index)))          (1+ (aref edebug-freq-count edebug-after-index)))
2389    (if edebug-test-coverage (edebug-update-coverage))    (if edebug-test-coverage (edebug-update-coverage))
# Line 2455  MSG is printed after `::::} '." Line 2455  MSG is printed after `::::} '."
2455    
2456  ;;;    (edebug-trace "exp: %s" edebug-value)  ;;;    (edebug-trace "exp: %s" edebug-value)
2457        ;; Test whether we should break.        ;; Test whether we should break.
2458        (setq edebug-break        (setq edebug-break
2459              (or edebug-global-break              (or edebug-global-break
2460                  (and edebug-break-data                  (and edebug-break-data
2461                       (or (not edebug-break-condition)                       (or (not edebug-break-condition)
# Line 2469  MSG is printed after `::::} '." Line 2469  MSG is printed after `::::} '."
2469                          (cdr (cdr edebug-data)))))                          (cdr (cdr edebug-data)))))
2470    
2471        ;; Display if mode is not go, continue, or Continue-fast        ;; Display if mode is not go, continue, or Continue-fast
2472        ;; or break, or input is pending,        ;; or break, or input is pending,
2473        (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))        (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
2474                edebug-break                edebug-break
2475                (edebug-input-pending-p))                (edebug-input-pending-p))
2476            (edebug-display))             ; <--------------- display            (edebug-display))             ; <--------------- display
2477        
2478        edebug-value        edebug-value
2479        )))        )))
2480    
# Line 2525  MSG is printed after `::::} '." Line 2525  MSG is printed after `::::} '."
2525          (edebug-outside-mark (edebug-mark))          (edebug-outside-mark (edebug-mark))
2526          edebug-outside-windows          ; window or screen configuration          edebug-outside-windows          ; window or screen configuration
2527          edebug-buffer-points          edebug-buffer-points
2528            
2529          edebug-eval-buffer              ; declared here so we can kill it below          edebug-eval-buffer              ; declared here so we can kill it below
2530          (edebug-eval-result-list (and edebug-eval-list          (edebug-eval-result-list (and edebug-eval-list
2531                                        (edebug-eval-result-list)))                                        (edebug-eval-result-list)))
# Line 2544  MSG is printed after `::::} '." Line 2544  MSG is printed after `::::} '."
2544            (if (not (buffer-name edebug-buffer))            (if (not (buffer-name edebug-buffer))
2545                (let ((debug-on-error nil))                (let ((debug-on-error nil))
2546                  (error "Buffer defining %s not found" edebug-function)))                  (error "Buffer defining %s not found" edebug-function)))
2547        
2548            (if (eq 'after edebug-arg-mode)            (if (eq 'after edebug-arg-mode)
2549                ;; Compute result string now before windows are modified.                ;; Compute result string now before windows are modified.
2550                (edebug-compute-previous-result edebug-value))                (edebug-compute-previous-result edebug-value))
2551    
2552            (if edebug-save-windows            (if edebug-save-windows
2553                ;; Save windows now before we modify them.                ;; Save windows now before we modify them.
2554                (setq edebug-outside-windows                (setq edebug-outside-windows
2555                      (edebug-current-windows edebug-save-windows)))                      (edebug-current-windows edebug-save-windows)))
2556        
2557            (if edebug-save-displayed-buffer-points            (if edebug-save-displayed-buffer-points
2558                (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))                (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
2559    
# Line 2569  MSG is printed after `::::} '." Line 2569  MSG is printed after `::::} '."
2569            (setcar edebug-window-data (selected-window))            (setcar edebug-window-data (selected-window))
2570    
2571            ;; Now display eval list, if any.            ;; Now display eval list, if any.
2572            ;; This is done after the pop to edebug-buffer            ;; This is done after the pop to edebug-buffer
2573            ;; so that buffer-window correspondence is correct after quitting.            ;; so that buffer-window correspondence is correct after quitting.
2574            (edebug-eval-display edebug-eval-result-list)            (edebug-eval-display edebug-eval-result-list)
2575            ;; The evaluation list better not have deleted edebug-window-data.            ;; The evaluation list better not have deleted edebug-window-data.
# Line 2578  MSG is printed after `::::} '." Line 2578  MSG is printed after `::::} '."
2578    
2579            (setq edebug-buffer-outside-point (point))            (setq edebug-buffer-outside-point (point))
2580            (goto-char edebug-point)            (goto-char edebug-point)
2581                
2582            (if (eq 'before edebug-arg-mode)            (if (eq 'before edebug-arg-mode)
2583                ;; Check whether positions are up-to-date.                ;; Check whether positions are up-to-date.
2584                ;; This assumes point is never before symbol.                ;; This assumes point is never before symbol.
2585                (if (not (memq (following-char) '(?\( ?\# ?\` )))                (if (not (memq (following-char) '(?\( ?\# ?\` )))
2586                    (let ((debug-on-error nil))                    (let ((debug-on-error nil))
2587                      (error "Source has changed - reevaluate definition of %s"                      (error "Source has changed - reevaluate definition of %s"
2588                             edebug-function)                             edebug-function)
2589                      )))                      )))
2590    
2591            (setcdr edebug-window-data            (setcdr edebug-window-data
2592                    (edebug-adjust-window (cdr edebug-window-data)))                    (edebug-adjust-window (cdr edebug-window-data)))
2593                
2594            ;; Test if there is input, not including keyboard macros.            ;; Test if there is input, not including keyboard macros.
2595            (if (edebug-input-pending-p)            (if (edebug-input-pending-p)
2596                (progn                (progn
2597                  (setq edebug-execution-mode 'step                  (setq edebug-execution-mode 'step
2598                        edebug-stop t)                        edebug-stop t)
# Line 2601  MSG is printed after `::::} '." Line 2601  MSG is printed after `::::} '."
2601                  ))                  ))
2602            ;; Now display arrow based on mode.            ;; Now display arrow based on mode.
2603            (edebug-overlay-arrow)            (edebug-overlay-arrow)
2604                
2605            (cond            (cond
2606             ((eq 'error edebug-arg-mode)             ((eq 'error edebug-arg-mode)
2607              ;; Display error message              ;; Display error message
# Line 2614  MSG is printed after `::::} '." Line 2614  MSG is printed after `::::} '."
2614             (edebug-break             (edebug-break
2615              (cond              (cond
2616               (edebug-global-break               (edebug-global-break
2617                (message "Global Break: %s => %s"                (message "Global Break: %s => %s"
2618                         edebug-global-break-condition                         edebug-global-break-condition
2619                         edebug-global-break-result))                         edebug-global-break-result))
2620               (edebug-break-condition               (edebug-break-condition
2621                (message "Break: %s => %s"                (message "Break: %s => %s"
2622                         edebug-break-condition                         edebug-break-condition
2623                         edebug-break-result))                         edebug-break-result))
2624               ((not (eq edebug-execution-mode 'Continue-fast))               ((not (eq edebug-execution-mode 'Continue-fast))
2625                (message "Break"))                (message "Break"))
# Line 2634  MSG is printed after `::::} '." Line 2634  MSG is printed after `::::} '."
2634                           (not (eq edebug-execution-mode 'Continue-fast)))                           (not (eq edebug-execution-mode 'Continue-fast)))
2635                      (sit-for 1))        ; Show break message.                      (sit-for 1))        ; Show break message.
2636                  (edebug-previous-result)))                  (edebug-previous-result)))
2637        
2638            (cond            (cond
2639             (edebug-break             (edebug-break
2640              (cond              (cond
# Line 2647  MSG is printed after `::::} '." Line 2647  MSG is printed after `::::} '."
2647             ((eq edebug-execution-mode 'Trace-fast)             ((eq edebug-execution-mode 'Trace-fast)
2648              (edebug-sit-for 0))         ; Force update and continue.              (edebug-sit-for 0))         ; Force update and continue.
2649             )             )
2650        
2651            (unwind-protect            (unwind-protect
2652                (if (or edebug-stop                (if (or edebug-stop
2653                        (memq edebug-execution-mode '(step next))                        (memq edebug-execution-mode '(step next))
2654                        (eq edebug-arg-mode 'error))                        (eq edebug-arg-mode 'error))
2655                    (progn                    (progn
2656                      ;; (setq edebug-execution-mode 'step)                      ;; (setq edebug-execution-mode 'step)
2657                      ;; (edebug-overlay-arrow)   ; This doesn't always show up.                      ;; (edebug-overlay-arrow)   ; This doesn't always show up.
# Line 2672  MSG is printed after `::::} '." Line 2672  MSG is printed after `::::} '."
2672              (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))              (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
2673              (if edebug-trace-window              (if edebug-trace-window
2674                  (setq edebug-trace-window-start                  (setq edebug-trace-window-start
2675                        (and edebug-trace-window                        (and edebug-trace-window
2676                             (window-start edebug-trace-window))))                             (window-start edebug-trace-window))))
2677    
2678              ;; Restore windows before continuing.              ;; Restore windows before continuing.
# Line 2688  MSG is printed after `::::} '." Line 2688  MSG is printed after `::::} '."
2688    
2689                    ;; Unrestore trace window's window-point.                    ;; Unrestore trace window's window-point.
2690                    (if edebug-trace-window                    (if edebug-trace-window
2691                        (set-window-start edebug-trace-window                        (set-window-start edebug-trace-window
2692                                          edebug-trace-window-start))                                          edebug-trace-window-start))
2693    
2694                    ;; Unrestore edebug-buffer's window-start, if displayed.                    ;; Unrestore edebug-buffer's window-start, if displayed.
2695                    (let ((window (car edebug-window-data)))                    (let ((window (car edebug-window-data)))
2696                      (if (and window (edebug-window-live-p window)                      (if (and window (edebug-window-live-p window)
2697                               (eq (window-buffer) edebug-buffer))                               (eq (window-buffer) edebug-buffer))
2698                          (progn                          (progn
2699                            (set-window-start window (cdr edebug-window-data)                            (set-window-start window (cdr edebug-window-data)
2700                                              'no-force)                                              'no-force)
2701                            ;; Unrestore edebug-buffer's window-point.                            ;; Unrestore edebug-buffer's window-point.
2702                            ;; Needed in addition to setting the buffer point                            ;; Needed in addition to setting the buffer point
# Line 2731  MSG is printed after `::::} '." Line 2731  MSG is printed after `::::} '."
2731            ;; None of the following is done if quit or signal occurs.            ;; None of the following is done if quit or signal occurs.
2732    
2733            ;; Restore edebug-buffer's outside point.            ;; Restore edebug-buffer's outside point.
2734            ;;    (edebug-trace "restore edebug-buffer point: %s"            ;;    (edebug-trace "restore edebug-buffer point: %s"
2735            ;;              edebug-buffer-outside-point)            ;;              edebug-buffer-outside-point)
2736            (let ((current-buffer (current-buffer)))            (let ((current-buffer (current-buffer)))
2737              (set-buffer edebug-buffer)              (set-buffer edebug-buffer)
# Line 2757  MSG is printed after `::::} '." Line 2757  MSG is printed after `::::} '."
2757  ;; Dynamically declared unbound vars  ;; Dynamically declared unbound vars
2758  (defvar edebug-outside-match-data) ; match data outside of edebug  (defvar edebug-outside-match-data) ; match data outside of edebug
2759  (defvar edebug-backtrace-buffer) ; each recursive edit gets its own  (defvar edebug-backtrace-buffer) ; each recursive edit gets its own
2760  (defvar edebug-inside-windows)  (defvar edebug-inside-windows)
2761  (defvar edebug-interactive-p)  (defvar edebug-interactive-p)
2762    
2763  (defvar edebug-outside-map)  (defvar edebug-outside-map)
# Line 2841  MSG is printed after `::::} '." Line 2841  MSG is printed after `::::} '."
2841                ;; Declare global values local but using the same global value.                ;; Declare global values local but using the same global value.
2842                ;; We could set these to the values for previous edebug call.                ;; We could set these to the values for previous edebug call.
2843                (last-command-char last-command-char)                (last-command-char last-command-char)
2844                (last-command last-command)                (last-command last-command)
2845                (this-command this-command)                (this-command this-command)
2846                (last-input-char last-input-char)                (last-input-char last-input-char)
2847    
# Line 2862  MSG is printed after `::::} '." Line 2862  MSG is printed after `::::} '."
2862                (debug-on-quit edebug-outside-debug-on-quit)                (debug-on-quit edebug-outside-debug-on-quit)
2863    
2864                ;; Don't keep defining a kbd macro.                ;; Don't keep defining a kbd macro.
2865                (defining-kbd-macro                (defining-kbd-macro
2866                  (if edebug-continue-kbd-macro defining-kbd-macro))                  (if edebug-continue-kbd-macro defining-kbd-macro))
2867    
2868                ;; others??                ;; others??
# Line 2906  MSG is printed after `::::} '." Line 2906  MSG is printed after `::::} '."
2906              ));; inner let              ));; inner let
2907    
2908        ;; Reset global vars to outside values, in case they have been changed.        ;; Reset global vars to outside values, in case they have been changed.
2909        (setq        (setq
2910         last-command-char edebug-outside-last-command-char         last-command-char edebug-outside-last-command-char
2911         last-command-event edebug-outside-last-command-event         last-command-event edebug-outside-last-command-event
2912         last-command edebug-outside-last-command         last-command edebug-outside-last-command
# Line 2931  MSG is printed after `::::} '." Line 2931  MSG is printed after `::::} '."
2931    
2932  (defun edebug-adjust-window (old-start)  (defun edebug-adjust-window (old-start)
2933    ;; If pos is not visible, adjust current window to fit following context.    ;; If pos is not visible, adjust current window to fit following context.
2934  ;;;  (message "window: %s old-start: %s window-start: %s pos: %s"  ;;;  (message "window: %s old-start: %s window-start: %s pos: %s"
2935  ;;;        (selected-window) old-start (window-start) (point)) (sit-for 5)  ;;;        (selected-window) old-start (window-start) (point)) (sit-for 5)
2936    (if (not (pos-visible-in-window-p))    (if (not (pos-visible-in-window-p))
2937        (progn        (progn
# Line 2951  MSG is printed after `::::} '." Line 2951  MSG is printed after `::::} '."
2951             (beginning-of-line)             (beginning-of-line)
2952             (point)))))))             (point)))))))
2953    (window-start))    (window-start))
2954      
2955    
2956    
2957  (defconst edebug-arrow-alist  (defconst edebug-arrow-alist
# Line 2968  MSG is printed after `::::} '." Line 2968  MSG is printed after `::::} '."
2968    
2969  (defun edebug-overlay-arrow ()  (defun edebug-overlay-arrow ()
2970    ;; Set up the overlay arrow at beginning-of-line in current buffer.    ;; Set up the overlay arrow at beginning-of-line in current buffer.
2971    ;; The arrow string is derived from edebug-arrow-alist and    ;; The arrow string is derived from edebug-arrow-alist and
2972    ;; edebug-execution-mode.    ;; edebug-execution-mode.
2973    (let ((pos (save-excursion (beginning-of-line) (point))))    (let ((pos (save-excursion (beginning-of-line) (point))))
2974      (setq overlay-arrow-string      (setq overlay-arrow-string
# Line 2996  configurations become the same as the cu Line 2996  configurations become the same as the cu
2996       (setq edebug-inside-windows (edebug-current-windows t))       (setq edebug-inside-windows (edebug-current-windows t))
2997       (edebug-set-windows edebug-outside-windows)       (edebug-set-windows edebug-outside-windows)
2998       ,@body;; Code to change edebug-save-windows       ,@body;; Code to change edebug-save-windows
2999       (setq edebug-outside-windows (edebug-current-windows       (setq edebug-outside-windows (edebug-current-windows
3000                                     edebug-save-windows))                                     edebug-save-windows))
3001       ;; Problem: what about outside windows that are deleted inside?       ;; Problem: what about outside windows that are deleted inside?
3002       (edebug-set-windows edebug-inside-windows)))       (edebug-set-windows edebug-inside-windows)))
3003    
3004  (defun edebug-toggle-save-selected-window ()  (defun edebug-toggle-save-selected-window ()
3005    "Toggle the saving and restoring of the selected window.    "Toggle the saving and restoring of the selected window.
3006  Also, each time you toggle it on, the inside and outside window  Also, each time you toggle it on, the inside and outside window
3007  configurations become the same as the current configuration."  configurations become the same as the current configuration."
3008    (interactive)    (interactive)
# Line 3055  Otherwise, toggle for all windows." Line 3055  Otherwise, toggle for all windows."
3055    (interactive)    (interactive)
3056    (if (not edebug-active)    (if (not edebug-active)
3057        (error "Edebug is not active"))        (error "Edebug is not active"))
3058    (setq edebug-inside-windows    (setq edebug-inside-windows
3059          (edebug-current-windows edebug-save-windows))          (edebug-current-windows edebug-save-windows))
3060    (edebug-set-windows edebug-outside-windows)    (edebug-set-windows edebug-outside-windows)
3061    (goto-char edebug-outside-point)    (goto-char edebug-outside-point)
# Line 3075  The default is one second." Line 3075  The default is one second."
3075      (save-window-excursion      (save-window-excursion
3076        (edebug-pop-to-buffer edebug-outside-buffer)        (edebug-pop-to-buffer edebug-outside-buffer)
3077        (goto-char edebug-outside-point)        (goto-char edebug-outside-point)
3078        (message "Current buffer: %s Point: %s Mark: %s"        (message "Current buffer: %s Point: %s Mark: %s"
3079                 (current-buffer) (point)                 (current-buffer) (point)
3080                 (if (marker-buffer (edebug-mark-marker))                 (if (marker-buffer (edebug-mark-marker))
3081                     (marker-position (edebug-mark-marker)) "<not set>"))                     (marker-position (edebug-mark-marker)) "<not set>"))
3082        (edebug-sit-for arg)        (edebug-sit-for arg)
3083        (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))        (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
3084    
3085    
3086  ;; Joe Wells, here is a start at your idea of adding a buffer to the internal  ;; Joe Wells, here is a start at your idea of adding a buffer to the internal
3087  ;; display list.  Still need to use this list in edebug-display.  ;; display list.  Still need to use this list in edebug-display.
3088    
3089  '(defvar edebug-display-buffer-list nil  '(defvar edebug-display-buffer-list nil
# Line 3144  The default is one second." Line 3144  The default is one second."
3144          (let* ((edebug-def-name (car edebug-stop-point))          (let* ((edebug-def-name (car edebug-stop-point))
3145                 (index (cdr edebug-stop-point))                 (index (cdr edebug-stop-point))
3146                 (edebug-data (get edebug-def-name 'edebug))                 (edebug-data (get edebug-def-name 'edebug))
3147                  
3148                 ;; pull out parts of edebug-data                 ;; pull out parts of edebug-data
3149                 (edebug-def-mark (car edebug-data))                 (edebug-def-mark (car edebug-data))
3150                 (edebug-breakpoints (car (cdr edebug-data)))                 (edebug-breakpoints (car (cdr edebug-data)))
# Line 3163  The default is one second." Line 3163  The default is one second."
3163                        (car edebug-breakpoints)))                        (car edebug-breakpoints)))
3164                (goto-char (+ edebug-def-mark                (goto-char (+ edebug-def-mark
3165                              (aref offset-vector (car breakpoint))))                              (aref offset-vector (car breakpoint))))
3166                  
3167                (message "%s"                (message "%s"
3168                         (concat (if (nth 2 breakpoint)                         (concat (if (nth 2 breakpoint)
3169                                     "Temporary " "")                                     "Temporary " "")
# Line 3179  The default is one second." Line 3179  The default is one second."
3179    "Modify the breakpoint for the form at point or after it according    "Modify the breakpoint for the form at point or after it according
3180  to FLAG: set if t, clear if nil.  Then move to that point.  to FLAG: set if t, clear if nil.  Then move to that point.
3181  If CONDITION or TEMPORARY are non-nil, add those attributes to  If CONDITION or TEMPORARY are non-nil, add those attributes to
3182  the breakpoint.  "    the breakpoint.  "
3183    (let ((edebug-stop-point (edebug-find-stop-point)))    (let ((edebug-stop-point (edebug-find-stop-point)))
3184      (if edebug-stop-point      (if edebug-stop-point
3185          (let* ((edebug-def-name (car edebug-stop-point))          (let* ((edebug-def-name (car edebug-stop-point))
3186                 (index (cdr edebug-stop-point))                 (index (cdr edebug-stop-point))
3187                 (edebug-data (get edebug-def-name 'edebug))                 (edebug-data (get edebug-def-name 'edebug))
3188                  
3189                 ;; pull out parts of edebug-data                 ;; pull out parts of edebug-data
3190                 (edebug-def-mark (car edebug-data))                 (edebug-def-mark (car edebug-data))
3191                 (edebug-breakpoints (car (cdr edebug-data)))                 (edebug-breakpoints (car (cdr edebug-data)))
# Line 3209  the breakpoint.  " Line 3209  the breakpoint.  "
3209              (if present              (if present
3210                  (message "Breakpoint unset in %s" edebug-def-name)                  (message "Breakpoint unset in %s" edebug-def-name)
3211                (message "No breakpoint here")))                (message "No breakpoint here")))
3212              
3213            (setcar (cdr edebug-data) edebug-breakpoints)            (setcar (cdr edebug-data) edebug-breakpoints)
3214            (goto-char (+ edebug-def-mark (aref offset-vector index)))            (goto-char (+ edebug-def-mark (aref offset-vector index)))
3215            ))))            ))))
# Line 3227  With prefix argument, make it a temporar Line 3227  With prefix argument, make it a temporar
3227    
3228    
3229  (defun edebug-set-global-break-condition (expression)  (defun edebug-set-global-break-condition (expression)
3230    (interactive (list (read-minibuffer    (interactive (list (read-minibuffer
3231                        "Global Condition: "                        "Global Condition: "
3232                        (format "%s" edebug-global-break-condition))))                        (format "%s" edebug-global-break-condition))))
3233    (setq edebug-global-break-condition expression))    (setq edebug-global-break-condition expression))
3234    
# Line 3319  Useful for exiting from trace or continu Line 3319  Useful for exiting from trace or continu
3319  '(defun edebug-forward ()  '(defun edebug-forward ()
3320    "Proceed to the exit of the next expression to be evaluated."    "Proceed to the exit of the next expression to be evaluated."
3321    (interactive)    (interactive)
3322    (edebug-set-mode    (edebug-set-mode
3323     'forward "Forward"     'forward "Forward"
3324     "Edebug will stop after exiting the next expression."))     "Edebug will stop after exiting the next expression."))
3325    
# Line 3381  go to the end of the last sexp, or if th Line 3381  go to the end of the last sexp, or if th
3381            func))))))            func))))))
3382    
3383  (defun edebug-instrument-callee ()  (defun edebug-instrument-callee ()
3384    "Instrument the definition of the function or macro about to be called.      "Instrument the definition of the function or macro about to be called.
3385  Do this when stopped before the form or it will be too late.  Do this when stopped before the form or it will be too late.
3386  One side effect of using this command is that the next time the  One side effect of using this command is that the next time the
3387  function or macro is called, Edebug will be called there as well."  function or macro is called, Edebug will be called there as well."
# Line 3399  function or macro is called, Edebug will Line 3399  function or macro is called, Edebug will
3399    
3400    
3401  (defun edebug-step-in ()  (defun edebug-step-in ()
3402    "Step into the definition of the function or macro about to be called.      "Step into the definition of the function or macro about to be called.
3403  This first does `edebug-instrument-callee' to ensure that it is  This first does `edebug-instrument-callee' to ensure that it is
3404  instrumented.  Then it does `edebug-on-entry' and switches to `go' mode."  instrumented.  Then it does `edebug-on-entry' and switches to `go' mode."
3405    (interactive)    (interactive)
3406    (let ((func (edebug-instrument-callee)))    (let ((func (edebug-instrument-callee)))
# Line 3421  cancelled the first time the function is Line 3421  cancelled the first time the function is
3421    (interactive "aEdebug on entry to: ")    (interactive "aEdebug on entry to: ")
3422    (put function 'edebug-on-entry nil))    (put function 'edebug-on-entry nil))
3423    
3424        
3425  (if (not (fboundp 'edebug-original-debug-on-entry))  (if (not (fboundp 'edebug-original-debug-on-entry))
3426      (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))      (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
3427  '(fset 'debug-on-entry 'edebug-debug-on-entry)  ;; Should we do this?  '(fset 'debug-on-entry 'edebug-debug-on-entry)  ;; Should we do this?
# Line 3513  Return the result of the last expression Line 3513  Return the result of the last expression
3513    `(save-excursion                      ; of current-buffer    `(save-excursion                      ; of current-buffer
3514       (if edebug-save-windows       (if edebug-save-windows
3515           (progn           (progn
3516             ;; After excursion, we will             ;; After excursion, we will
3517             ;; restore to current window configuration.             ;; restore to current window configuration.
3518             (setq edebug-inside-windows             (setq edebug-inside-windows
3519                   (edebug-current-windows edebug-save-windows))                   (edebug-current-windows edebug-save-windows))
# Line 3565  Return the result of the last expression Line 3565  Return the result of the last expression
3565               (edebug-set-windows edebug-inside-windows))               (edebug-set-windows edebug-inside-windows))
3566    
3567           ;; Save values that may have been changed.           ;; Save values that may have been changed.
3568           (setq           (setq
3569            edebug-outside-last-command-char last-command-char            edebug-outside-last-command-char last-command-char
3570            edebug-outside-last-command-event last-command-event            edebug-outside-last-command-event last-command-event
3571            edebug-outside-last-command last-command            edebug-outside-last-command last-command
# Line 3601  Return the result of the last expression Line 3601  Return the result of the last expression
3601      (eval edebug-expr)))      (eval edebug-expr)))
3602    
3603  (defun edebug-safe-eval (edebug-expr)  (defun edebug-safe-eval (edebug-expr)
3604    ;; Evaluate EXPR safely.    ;; Evaluate EXPR safely.
3605    ;; If there is an error, a string is returned describing the error.    ;; If there is an error, a string is returned describing the error.
3606    (condition-case edebug-err    (condition-case edebug-err
3607        (edebug-eval edebug-expr)        (edebug-eval edebug-expr)
3608      (error (edebug-format "%s: %s"  ;; could      (error (edebug-format "%s: %s"  ;; could
3609                            (get (car edebug-err) 'error-message)                            (get (car edebug-err) 'error-message)
3610                            (car (cdr edebug-err))))))                            (car (cdr edebug-err))))))
3611    
# Line 3650  Return the result of the last expression Line 3650  Return the result of the last expression
3650  (defun edebug-report-error (edebug-value)  (defun edebug-report-error (edebug-value)
3651    ;; Print an error message like command level does.    ;; Print an error message like command level does.
3652    ;; This also prints the error name if it has no error-message.    ;; This also prints the error name if it has no error-message.
3653    (message "%s: %s"    (message "%s: %s"
3654             (or (get (car edebug-value) 'error-message)             (or (get (car edebug-value) 'error-message)
3655                 (format "peculiar error (%s)" (car edebug-value)))                 (format "peculiar error (%s)" (car edebug-value)))
3656             (mapconcat (function (lambda (edebug-arg)             (mapconcat (function (lambda (edebug-arg)
3657                                    ;; continuing after an error may                                    ;; continuing after an error may
3658                                    ;; complain about edebug-arg. why??                                    ;; complain about edebug-arg. why??
3659                                    (prin1-to-string edebug-arg)))                                    (prin1-to-string edebug-arg)))
# Line 3663  Return the result of the last expression Line 3663  Return the result of the last expression
3663  (defvar print-level nil)  (defvar print-level nil)
3664  (defvar print-circle nil)  (defvar print-circle nil)
3665  (defvar print-readably) ;; defined by lemacs  (defvar print-readably) ;; defined by lemacs
3666  ;; Alternatively, we could change the definition of  ;; Alternatively, we could change the definition of
3667  ;; edebug-safe-prin1-to-string to only use these if defined.  ;; edebug-safe-prin1-to-string to only use these if defined.
3668    
3669  (defun edebug-safe-prin1-to-string (value)  (defun edebug-safe-prin1-to-string (value)
# Line 3682  Return the result of the last expression Line 3682  Return the result of the last expression
3682              (format "Result: %s = %s" edebug-previous-value              (format "Result: %s = %s" edebug-previous-value
3683                      (single-key-description edebug-previous-value))                      (single-key-description edebug-previous-value))
3684            (if edebug-unwrap-results            (if edebug-unwrap-results
3685                (setq edebug-previous-value                (setq edebug-previous-value
3686                      (edebug-unwrap* edebug-previous-value)))                      (edebug-unwrap* edebug-previous-value)))
3687            (concat "Result: "            (concat "Result: "
3688                    (edebug-safe-prin1-to-string edebug-previous-value)))))                    (edebug-safe-prin1-to-string edebug-previous-value)))))
3689    
3690  (defun edebug-previous-result ()  (defun edebug-previous-result ()
# Line 3695  Return the result of the last expression Line 3695  Return the result of the last expression
3695  ;;; Read, Eval and Print  ;;; Read, Eval and Print
3696    
3697  (defun edebug-eval-expression (edebug-expr)  (defun edebug-eval-expression (edebug-expr)
3698    "Evaluate an expression in the outside environment.      "Evaluate an expression in the outside environment.
3699  If interactive, prompt for the expression.  If interactive, prompt for the expression.
3700  Print result in minibuffer."  Print result in minibuffer."
3701    (interactive (list (read-from-minibuffer    (interactive (list (read-from-minibuffer
3702                        "Eval: " nil read-expression-map t                        "Eval: " nil read-expression-map t
3703                        'read-expression-history)))                        'read-expression-history)))
3704    (princ    (princ
# Line 3713  print value in minibuffer." Line 3713  print value in minibuffer."
3713    (edebug-eval-expression (edebug-last-sexp)))    (edebug-eval-expression (edebug-last-sexp)))
3714    
3715  (defun edebug-eval-print-last-sexp ()  (defun edebug-eval-print-last-sexp ()
3716    "Evaluate sexp before point in the outside environment;    "Evaluate sexp before point in the outside environment;
3717  print value into current buffer."  print value into current buffer."
3718    (interactive)    (interactive)
3719    (let* ((edebug-form (edebug-last-sexp))    (let* ((edebug-form (edebug-last-sexp))
3720           (edebug-result-string           (edebug-result-string
3721            (edebug-outside-excursion            (edebug-outside-excursion
3722             (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))             (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
3723           (standard-output (current-buffer)))           (standard-output (current-buffer)))
3724      (princ "\n")      (princ "\n")
# Line 3727  print value into current buffer." Line 3727  print value into current buffer."
3727      (princ "\n")      (princ "\n")
3728      ))      ))
3729    
3730  ;;; Edebug Minor Mode  ;;; Edebug Minor Mode
3731    
3732  ;; Global GUD bindings for all emacs-lisp-mode buffers.  ;; Global GUD bindings for all emacs-lisp-mode buffers.
3733  (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-s" 'edebug-step-mode)
3734  (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-n" 'edebug-next-mode)
3735  (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-c" 'edebug-go-mode)
3736  (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)  (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
3737        
3738    
3739  (defvar edebug-mode-map nil)  (defvar edebug-mode-map nil)
3740  (if edebug-mode-map  (if edebug-mode-map
# Line 3758  print value into current buffer." Line 3758  print value into current buffer."
3758      (define-key edebug-mode-map "I" 'edebug-instrument-callee)      (define-key edebug-mode-map "I" 'edebug-instrument-callee)
3759      (define-key edebug-mode-map "i" 'edebug-step-in)      (define-key edebug-mode-map "i" 'edebug-step-in)
3760      (define-key edebug-mode-map "o" 'edebug-step-out)      (define-key edebug-mode-map "o" 'edebug-step-out)
3761        
3762      ;; quitting and stopping      ;; quitting and stopping
3763      (define-key edebug-mode-map "q" 'top-level)      (define-key edebug-mode-map "q" 'top-level)
3764      (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)      (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
# Line 3771  print value into current buffer." Line 3771  print value into current buffer."
3771      (define-key edebug-mode-map "B" 'edebug-next-breakpoint)      (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
3772      (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)      (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
3773      (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)      (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
3774        
3775      ;; evaluation      ;; evaluation
3776      (define-key edebug-mode-map "r" 'edebug-previous-result)      (define-key edebug-mode-map "r" 'edebug-previous-result)
3777      (define-key edebug-mode-map "e" 'edebug-eval-expression)      (define-key edebug-mode-map "e" 'edebug-eval-expression)
3778      (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)      (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
3779      (define-key edebug-mode-map "E" 'edebug-visit-eval-list)      (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
3780        
3781      ;; views      ;; views
3782      (define-key edebug-mode-map "w" 'edebug-where)      (define-key edebug-mode-map "w" 'edebug-where)
3783      (define-key edebug-mode-map "v" 'edebug-view-outside)  ;; maybe obsolete??      (define-key edebug-mode-map "v" 'edebug-view-outside)  ;; maybe obsolete??
# Line 3788  print value into current buffer." Line 3788  print value into current buffer."
3788      ;; misc      ;; misc
3789      (define-key edebug-mode-map "?" 'edebug-help)      (define-key edebug-mode-map "?" 'edebug-help)
3790      (define-key edebug-mode-map "d" 'edebug-backtrace)      (define-key edebug-mode-map "d" 'edebug-backtrace)
3791        
3792      (define-key edebug-mode-map "-" 'negative-argument)      (define-key edebug-mode-map "-" 'negative-argument)
3793    
3794      ;; statistics      ;; statistics
# Line 3801  print value into current buffer." Line 3801  print value into current buffer."
3801    
3802      (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)      (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)
3803      (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)      (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)
3804      (define-key edebug-mode-map "\C-c\C-t"      (define-key edebug-mode-map "\C-c\C-t"
3805        (function (lambda () (edebug-set-breakpoint t))))        (function (lambda () (edebug-set-breakpoint t))))
3806      (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)      (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)
3807      ))      ))
# Line 3858  print value into current buffer." Line 3858  print value into current buffer."
3858    
3859  In addition to all Emacs Lisp commands (except those that modify the  In addition to all Emacs Lisp commands (except those that modify the
3860  buffer) there are local and global key bindings to several Edebug  buffer) there are local and global key bindings to several Edebug
3861  specific commands.  E.g. `edebug-step-mode' is bound to \\[edebug-step-mode]  specific commands.  E.g. `edebug-step-mode' is bound to \\[edebug-step-mode]
3862  in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.  in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
3863    
3864  Also see bindings for the eval list buffer, *edebug*.  Also see bindings for the eval list buffer, *edebug*.
# Line 3899  edebug-global-break-condition Line 3899  edebug-global-break-condition
3899    ;; Assumes in outside environment.    ;; Assumes in outside environment.
3900    ;; Don't do any edebug things now.    ;; Don't do any edebug things now.
3901    (let ((edebug-execution-mode 'Go-nonstop)    (let ((edebug-execution-mode 'Go-nonstop)
3902          (edebug-trace nil))          (edebug-trace nil))
3903      (mapcar 'edebug-safe-eval edebug-eval-list)))      (mapcar 'edebug-safe-eval edebug-eval-list)))
3904    
3905  (defun edebug-eval-display-list (edebug-eval-result-list)  (defun edebug-eval-display-list (edebug-eval-result-list)
# Line 3963  May only be called from within edebug-re Line 3963  May only be called from within edebug-re
3963          (progn          (progn
3964            (forward-sexp 1)            (forward-sexp 1)
3965            (setq new-list (cons (edebug-last-sexp) new-list))))            (setq new-list (cons (edebug-last-sexp) new-list))))
3966        
3967      (while (re-search-forward "^;" nil t)      (while (re-search-forward "^;" nil t)
3968        (forward-line 1)        (forward-line 1)
3969        (skip-chars-forward " \t\n\r")        (skip-chars-forward " \t\n\r")
# Line 3972  May only be called from within edebug-re Line 3972  May only be called from within edebug-re
3972            (progn            (progn
3973              (forward-sexp 1)              (forward-sexp 1)
3974              (setq new-list (cons (edebug-last-sexp) new-list)))))              (setq new-list (cons (edebug-last-sexp) new-list)))))
3975        
3976      (setq edebug-eval-list (nreverse new-list))      (setq edebug-eval-list (nreverse new-list))
3977      (edebug-eval-redisplay)      (edebug-eval-redisplay)
3978      (goto-char starting-point)))      (goto-char starting-point)))
# Line 3998  May only be called from within edebug-re Line 3998  May only be called from within edebug-re
3998  (if edebug-eval-mode-map  (if edebug-eval-mode-map
3999      nil      nil
4000    (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))    (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
4001      
4002    (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)    (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
4003    (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)    (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
4004    (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)    (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
# Line 4037  Global commands prefixed by global-edebu Line 4037  Global commands prefixed by global-edebu
4037  ;; edebug is not dependent on this, yet.  ;; edebug is not dependent on this, yet.
4038    
4039  (defun edebug (&optional edebug-arg-mode &rest debugger-args)  (defun edebug (&optional edebug-arg-mode &rest debugger-args)
4040    "Replacement for debug.      "Replacement for debug.
4041  If we are running an edebugged function,  If we are running an edebugged function,
4042  show where we last were.  Otherwise call debug normally."  show where we last were.  Otherwise call debug normally."
4043  ;;  (message "entered: %s  depth: %s  edebug-recursion-depth: %s"  ;;  (message "entered: %s  depth: %s  edebug-recursion-depth: %s"
# Line 4055  show where we last were.  Otherwise call Line 4055  show where we last were.  Otherwise call
4055              (edebug-break (null edebug-arg-mode)) ;; if called explicitly              (edebug-break (null edebug-arg-mode)) ;; if called explicitly
4056              )              )
4057          (edebug-display)          (edebug-display)
4058          (if (eq edebug-arg-mode 'error)          (if (eq edebug-arg-mode 'error)
4059              nil              nil
4060            edebug-value))            edebug-value))
4061    
# Line 4081  show where we last were.  Otherwise call Line 4081  show where we last were.  Otherwise call
4081            last-ok-point)            last-ok-point)
4082        (backtrace)        (backtrace)
4083    
4084        ;; Clean up the backtrace.          ;; Clean up the backtrace.
4085        ;; Not quite right for current edebug scheme.        ;; Not quite right for current edebug scheme.
4086        (set-buffer edebug-backtrace-buffer)        (set-buffer edebug-backtrace-buffer)
4087        (setq truncate-lines t)        (setq truncate-lines t)
# Line 4092  show where we last were.  Otherwise call Line 4092  show where we last were.  Otherwise call
4092        ;; Delete interspersed edebug internals.        ;; Delete interspersed edebug internals.
4093        (while (re-search-forward "^  \(?edebug" nil t)        (while (re-search-forward "^  \(?edebug" nil t)
4094          (beginning-of-line)          (beginning-of-line)
4095          (cond          (cond
4096           ((looking-at "^  \(edebug-after")           ((looking-at "^  \(edebug-after")
4097            ;; Previous lines may contain code, so just delete this line            ;; Previous lines may contain code, so just delete this line
4098            (setq last-ok-point (point))            (setq last-ok-point (point))
# Line 4186  reinstrument it." Line 4186  reinstrument it."
4186                last-index i)                last-index i)
4187    
4188          ;; Find all indexes on same line.          ;; Find all indexes on same line.
4189          (while (and (<= 0 (setq i (1- i)))          (while (and (<= 0 (setq i (1- i)))
4190                      (<= start-of-line (aref edebug-points i))))                      (<= start-of-line (aref edebug-points i))))
4191          ;; Insert all the indices for this line.          ;; Insert all the indices for this line.
4192          (forward-line 1)          (forward-line 1)
# Line 4202  reinstrument it." Line 4202  reinstrument it."
4202                         (goto-char (+ (aref edebug-points i) def-mark))                         (goto-char (+ (aref edebug-points i) def-mark))
4203                         (- (current-column)                         (- (current-column)
4204                            (if (= ?\( (following-char)) 0 1)))))                            (if (= ?\( (following-char)) 0 1)))))
4205              (insert (make-string              (insert (make-string
4206                       (max 0 (- col (- (point) start-of-count-line))) ?\ )                       (max 0 (- col (- (point) start-of-count-line))) ?\ )
4207                      (if (and (< 0 count)                      (if (and (< 0 count)
4208                               (not (memq coverage                               (not (memq coverage
4209                                          '(unknown ok-coverage))))                                          '(unknown ok-coverage))))
4210                          "=" "")                          "=" "")
4211                      (if (= count last-count) "" (int-to-string count))                      (if (= count last-count) "" (int-to-string count))
# Line 4291  It is removed when you hit any char." Line 4291  It is removed when you hit any char."
4291        :style toggle :selected edebug-test-coverage]        :style toggle :selected edebug-test-coverage]
4292       ["Save Windows" edebug-toggle-save-windows       ["Save Windows" edebug-toggle-save-windows
4293        :style toggle :selected edebug-save-windows]        :style toggle :selected edebug-save-windows]
4294       ["Save Point"       ["Save Point"
4295        (edebug-toggle 'edebug-save-displayed-buffer-points)        (edebug-toggle 'edebug-save-displayed-buffer-points)
4296        :style toggle :selected edebug-save-displayed-buffer-points]        :style toggle :selected edebug-save-displayed-buffer-points]
4297       ))       ))
# Line 4311  It is removed when you hit any char." Line 4311  It is removed when you hit any char."
4311  The condition is evaluated in the outside context.  The condition is evaluated in the outside context.
4312  With prefix argument, make it a temporary breakpoint."  With prefix argument, make it a temporary breakpoint."
4313    ;; (interactive "P\nxCondition: ")    ;; (interactive "P\nxCondition: ")
4314    (interactive    (interactive
4315     (list     (list
4316      current-prefix-arg      current-prefix-arg
4317  ;; Read condition as follows; getting previous condition is cumbersome:  ;; Read condition as follows; getting previous condition is cumbersome:
# Line 4329  With prefix argument, make it a temporar Line 4329  With prefix argument, make it a temporar
4329                        (cons edebug-break-condition read-expression-history)                        (cons edebug-break-condition read-expression-history)
4330                      read-expression-history)))                      read-expression-history)))
4331              (prog1              (prog1
4332                  (read-from-minibuffer                  (read-from-minibuffer
4333                   "Condition: " nil read-expression-map t                   "Condition: " nil read-expression-map t
4334                   'edebug-expression-history)                   'edebug-expression-history)
4335                (setq read-expression-history edebug-expression-history)                (setq read-expression-history edebug-expression-history)
# Line 4351  With prefix argument, make it a temporar Line 4351  With prefix argument, make it a temporar
4351  ;; Disabled before edebug-recursive-edit.  ;; Disabled before edebug-recursive-edit.
4352  (eval-when-compile  (eval-when-compile
4353    (if edebug-unread-command-char-warning    (if edebug-unread-command-char-warning
4354        (put 'unread-command-char 'byte-obsolete-variable        (put 'unread-command-char 'byte-obsolete-variable
4355             edebug-unread-command-char-warning)))             edebug-unread-command-char-warning)))
4356    
4357  (eval-when-compile  (eval-when-compile
# Line 4362  With prefix argument, make it a temporar Line 4362  With prefix argument, make it a temporar
4362    
4363    (defun byte-compile-resolve-functions (funcs)    (defun byte-compile-resolve-functions (funcs)
4364      "Say it is OK for the named functions to be unresolved."      "Say it is OK for the named functions to be unresolved."
4365      (mapcar      (mapcar
4366       (function       (function
4367        (lambda (func)        (lambda (func)
4368          (setq byte-compile-unresolved-functions          (setq byte-compile-unresolved-functions
4369                (delq (assq func byte-compile-unresolved-functions)                (delq (assq func byte-compile-unresolved-functions)
4370                      byte-compile-unresolved-functions))))                      byte-compile-unresolved-functions))))
4371       funcs)       funcs)
4372      nil)      nil)
4373      
4374    '(defun byte-compile-resolve-free-references (vars)    '(defun byte-compile-resolve-free-references (vars)
4375       "Say it is OK for the named variables to be referenced."       "Say it is OK for the named variables to be referenced."
4376       (mapcar       (mapcar
4377        (function        (function
4378         (lambda (var)         (lambda (var)
4379           (setq byte-compile-free-references           (setq byte-compile-free-references
4380                 (delq var byte-compile-free-references))))                 (delq var byte-compile-free-references))))
# Line 4383  With prefix argument, make it a temporar Line 4383  With prefix argument, make it a temporar
4383    
4384    '(defun byte-compile-resolve-free-assignments (vars)    '(defun byte-compile-resolve-free-assignments (vars)
4385       "Say it is OK for the named variables to be assigned."       "Say it is OK for the named variables to be assigned."
4386       (mapcar       (mapcar
4387        (function        (function
4388         (lambda (var)         (lambda (var)
4389           (setq byte-compile-free-assignments           (setq byte-compile-free-assignments
4390                 (delq var byte-compile-free-assignments))))                 (delq var byte-compile-free-assignments))))
4391        vars)        vars)
4392       nil)       nil)
4393    
4394    (byte-compile-resolve-functions    (byte-compile-resolve-functions
4395     '(reporter-submit-bug-report     '(reporter-submit-bug-report
4396       edebug-gensym ;; also in cl.el       edebug-gensym ;; also in cl.el
4397       ;; Interfaces to standard functions.       ;; Interfaces to standard functions.
4398       edebug-original-eval-defun       edebug-original-eval-defun
4399       edebug-original-read       edebug-original-read
4400       edebug-get-buffer-window       edebug-get-buffer-window
4401       edebug-mark       edebug-mark
4402       edebug-mark-marker       edebug-mark-marker
4403       edebug-input-pending-p       edebug-input-pending-p
4404       edebug-sit-for       edebug-sit-for
4405       edebug-prin1-to-string       edebug-prin1-to-string
4406       edebug-format       edebug-format
4407       ;; lemacs       ;; lemacs
4408       zmacs-deactivate-region       zmacs-deactivate-region
# Line 4432  With prefix argument, make it a temporar Line 4432  With prefix argument, make it a temporar
4432    (add-hook 'cl-load-hook    (add-hook 'cl-load-hook
4433              (function (lambda () (require 'cl-specs)))))              (function (lambda () (require 'cl-specs)))))
4434    
4435  ;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu  ;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
4436  (if (featurep 'cl-read)  (if (featurep 'cl-read)
4437      (add-hook 'edebug-setup-hook      (add-hook 'edebug-setup-hook
4438                (function (lambda () (require 'edebug-cl-read))))                (function (lambda () (require 'edebug-cl-read))))

Legend:
Removed from v.3.56  
changed lines
  Added in v.3.57

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26