/[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.49.4.1 by rms, Tue Aug 20 17:27:37 2002 UTC revision 3.49.4.2 by lektu, Mon Oct 21 09:07:55 2002 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 266  Both SYMBOL and SPEC are unevaluated. Th Line 266  Both SYMBOL and SPEC are unevaluated. Th
266    
267  (defun edebug-gensym (&optional prefix)  (defun edebug-gensym (&optional prefix)
268    "Generate a fresh uninterned symbol.    "Generate a fresh uninterned symbol.
269  There is an  optional argument, PREFIX.  PREFIX is the  There is an optional argument, PREFIX.  PREFIX is the
270  string that begins the new name. Most people take just the default,  string that begins the new name.  Most people take just the default,
271  except when debugging needs suggest otherwise."  except when debugging needs suggest otherwise."
272    (if (null prefix)    (if (null prefix)
273        (setq prefix "G"))        (setq prefix "G"))
# Line 320  A lambda list keyword is a symbol that s Line 320  A lambda list keyword is a symbol that s
320    (while (and (symbolp object) (fboundp object))    (while (and (symbolp object) (fboundp object))
321      (setq object (symbol-function object)))      (setq object (symbol-function object)))
322    object)    object)
323      
324  (defun edebug-macrop (object)  (defun edebug-macrop (object)
325    "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."
326    (setq object (edebug-lookup-function object))    (setq object (edebug-lookup-function object))
# Line 371  Return the result of the last expression Line 371  Return the result of the last expression
371    
372  (defun edebug-pop-to-buffer (buffer &optional window)  (defun edebug-pop-to-buffer (buffer &optional window)
373    ;; Like pop-to-buffer, but select window where BUFFER was last shown.    ;; Like pop-to-buffer, but select window where BUFFER was last shown.
374    ;; Select WINDOW if it provided and it still exists.  Otherwise,    ;; Select WINDOW if it provided and it still exists.  Otherwise,
375    ;; if buffer is currently shown in several windows, choose one.    ;; if buffer is currently shown in several windows, choose one.
376    ;; Otherwise, find a new window, possibly splitting one.    ;; Otherwise, find a new window, possibly splitting one.
377    (setq window (if (and (windowp window) (edebug-window-live-p window)    (setq window (if (and (windowp window) (edebug-window-live-p window)
# Line 434  Return the result of the last expression Line 434  Return the result of the last expression
434  (defun edebug-set-windows (window-info)  (defun edebug-set-windows (window-info)
435    ;; Set either a full window configuration or some window information.    ;; Set either a full window configuration or some window information.
436    (if (listp window-info)    (if (listp window-info)
437        (mapcar (function        (mapcar (function
438                 (lambda (one-window-info)                 (lambda (one-window-info)
439                   (if one-window-info                   (if one-window-info
440                       (apply (function                       (apply (function
441                               (lambda (window buffer point start hscroll)                               (lambda (window buffer point start hscroll)
442                                 (if (edebug-window-live-p window)                                 (if (edebug-window-live-p window)
443                                     (progn                                     (progn
# Line 540  This is like `eval-defun', but the code Line 540  This is like `eval-defun', but the code
540  Print its name in the minibuffer and leave point where it is,  Print its name in the minibuffer and leave point where it is,
541  or if an error occurs, leave point after it with mark at the original point."  or if an error occurs, leave point after it with mark at the original point."
542    (interactive)    (interactive)
543    (eval    (eval
544     ;; Bind edebug-all-forms only while reading, not while evalling     ;; Bind edebug-all-forms only while reading, not while evalling
545     ;; but this causes problems while edebugging edebug.     ;; but this causes problems while edebugging edebug.
546     (let ((edebug-all-forms t)     (let ((edebug-all-forms t)
# Line 565  or if an error occurs, leave point after Line 565  or if an error occurs, leave point after
565    "Toggle edebugging of all definitions."    "Toggle edebugging of all definitions."
566    (interactive)    (interactive)
567    (setq edebug-all-defs (not edebug-all-defs))    (setq edebug-all-defs (not edebug-all-defs))
568    (message "Edebugging all definitions is %s."    (message "Edebugging all definitions is %s."
569             (if edebug-all-defs "on" "off")))             (if edebug-all-defs "on" "off")))
570    
571    
# Line 573  or if an error occurs, leave point after Line 573  or if an error occurs, leave point after
573    "Toggle edebugging of all forms."    "Toggle edebugging of all forms."
574    (interactive)    (interactive)
575    (setq edebug-all-forms (not edebug-all-forms))    (setq edebug-all-forms (not edebug-all-forms))
576    (message "Edebugging all forms is %s."    (message "Edebugging all forms is %s."
577             (if edebug-all-forms "on" "off")))             (if edebug-all-forms "on" "off")))
578    
579    
# Line 593  or if an error occurs, leave point after Line 593  or if an error occurs, leave point after
593  ;;; Edebug internal data  ;;; Edebug internal data
594    
595  ;; The internal data that is needed for edebugging is kept in the  ;; The internal data that is needed for edebugging is kept in the
596  ;; buffer-local variable `edebug-form-data'.  ;; buffer-local variable `edebug-form-data'.
597    
598  (make-variable-buffer-local 'edebug-form-data)  (make-variable-buffer-local 'edebug-form-data)
599    
# Line 662  or if an error occurs, leave point after Line 662  or if an error occurs, leave point after
662    (setq edebug-form-data (cons new-entry edebug-form-data)))    (setq edebug-form-data (cons new-entry edebug-form-data)))
663    
664  (defun edebug-clear-form-data-entry (entry)  (defun edebug-clear-form-data-entry (entry)
665  ;; If non-nil, clear ENTRY out of the form data.    ;; If non-nil, clear ENTRY out of the form data.
666  ;; Maybe clear the markers and delete the symbol's edebug property?  ;; Maybe clear the markers and delete the symbol's edebug property?
667    (if entry    (if entry
668        (progn        (progn
669          ;; Instead of this, we could just find all contained forms.          ;; Instead of this, we could just find all contained forms.
670          ;; (put (car entry) 'edebug nil)   ;          ;; (put (car entry) 'edebug nil)   ;
671          ;; (mapcar 'edebug-clear-form-data-entry   ; dangerous          ;; (mapcar 'edebug-clear-form-data-entry   ; dangerous
672          ;;   (get (car entry) 'edebug-dependents))          ;;   (get (car entry) 'edebug-dependents))
673          ;; (set-marker (nth 1 entry) nil)          ;; (set-marker (nth 1 entry) nil)
# Line 798  or if an error occurs, leave point after Line 798  or if an error occurs, leave point after
798      ;; 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.
799      (setq edebug-read-dotted-list nil)      (setq edebug-read-dotted-list nil)
800      ;; Drop the corresponding offset pair.      ;; Drop the corresponding offset pair.
801      ;; That is, nconc the reverse of the rest of the offsets      ;; That is, nconc the reverse of the rest of the offsets
802      ;; with the cdr of last offset.      ;; with the cdr of last offset.
803      (setcdr edebug-current-offset      (setcdr edebug-current-offset
804              (nconc (nreverse (cdr (cdr edebug-current-offset)))              (nconc (nreverse (cdr (cdr edebug-current-offset)))
# Line 819  or if an error occurs, leave point after Line 819  or if an error occurs, leave point after
819    
820  (defmacro edebug-storing-offsets (point &rest body)  (defmacro edebug-storing-offsets (point &rest body)
821    `(unwind-protect    `(unwind-protect
822         (progn         (progn
823           (edebug-store-before-offset ,point)           (edebug-store-before-offset ,point)
824           ,@body)           ,@body)
825       (edebug-store-after-offset (point))))       (edebug-store-after-offset (point))))
826    
827    
# Line 905  This controls how we read comma construc Line 905  This controls how we read comma construc
905    (forward-char 1)    (forward-char 1)
906    (cond ((eq ?\' (following-char))    (cond ((eq ?\' (following-char))
907           (forward-char 1)           (forward-char 1)
908           (list           (list
909            (edebug-storing-offsets (point)              (edebug-storing-offsets (point)
910              (if (featurep 'cl) 'function* 'function))              (if (featurep 'cl) 'function* 'function))
911            (edebug-read-storing-offsets stream)))            (edebug-read-storing-offsets stream)))
912          ((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 917  This controls how we read comma construc Line 917  This controls how we read comma construc
917    
918  (defun edebug-read-list (stream)  (defun edebug-read-list (stream)
919    (forward-char 1)                      ; skip \(    (forward-char 1)                      ; skip \(
920    (prog1    (prog1
921        (let ((elements))        (let ((elements))
922          (while (not (memq (edebug-next-token-class) '(rparen dot)))          (while (not (memq (edebug-next-token-class) '(rparen dot)))
923            (if (eq (edebug-next-token-class) 'backquote)            (if (eq (edebug-next-token-class) 'backquote)
# Line 948  This controls how we read comma construc Line 948  This controls how we read comma construc
948    
949  (defun edebug-read-vector (stream)  (defun edebug-read-vector (stream)
950    (forward-char 1)                      ; skip \[    (forward-char 1)                      ; skip \[
951    (prog1    (prog1
952        (let ((elements))        (let ((elements))
953          (while (not (eq 'rbracket (edebug-next-token-class)))          (while (not (eq 'rbracket (edebug-next-token-class)))
954            (setq elements (cons (edebug-read-storing-offsets stream) elements)))            (setq elements (cons (edebug-read-storing-offsets stream) elements)))
# Line 962  This controls how we read comma construc Line 962  This controls how we read comma construc
962    
963  (defun edebug-new-cursor (expressions offsets)  (defun edebug-new-cursor (expressions offsets)
964    ;; Return a new cursor for EXPRESSIONS with OFFSETS.    ;; Return a new cursor for EXPRESSIONS with OFFSETS.
965    (if (vectorp expressions)    (if (vectorp expressions)
966        (setq expressions (append expressions nil)))        (setq expressions (append expressions nil)))
967    (cons expressions offsets))    (cons expressions offsets))
968    
# Line 1009  This controls how we read comma construc Line 1009  This controls how we read comma construc
1009    ;; This is a violation of the cursor encapsulation, but    ;; This is a violation of the cursor encapsulation, but
1010    ;; there is plenty of that going on while matching.    ;; there is plenty of that going on while matching.
1011    ;; The following test should always fail.    ;; The following test should always fail.
1012    (if (edebug-empty-cursor cursor)    (if (edebug-empty-cursor cursor)
1013        (edebug-no-match cursor "Not enough arguments."))        (edebug-no-match cursor "Not enough arguments."))
1014    (setcar cursor (cdr (car cursor)))    (setcar cursor (cdr (car cursor)))
1015    (setcdr cursor (cdr (cdr cursor)))    (setcdr cursor (cdr (cdr cursor)))
# Line 1019  This controls how we read comma construc Line 1019  This controls how we read comma construc
1019  (defun edebug-before-offset (cursor)  (defun edebug-before-offset (cursor)
1020    ;; Return the before offset of the cursor.    ;; Return the before offset of the cursor.
1021    ;; If there is nothing left in the offsets,    ;; If there is nothing left in the offsets,
1022    ;; return one less than the offset itself,    ;; return one less than the offset itself,
1023    ;; which is the after offset for a list.    ;; which is the after offset for a list.
1024    (let ((offset (edebug-cursor-offsets cursor)))    (let ((offset (edebug-cursor-offsets cursor)))
1025      (if (consp offset)      (if (consp offset)
# Line 1126  This controls how we read comma construc Line 1126  This controls how we read comma construc
1126                  defining-form-p (and (listp spec)                  defining-form-p (and (listp spec)
1127                                       (eq '&define (car spec)))                                       (eq '&define (car spec)))
1128                  ;; This is incorrect in general!! But OK most of the time.                  ;; This is incorrect in general!! But OK most of the time.
1129                  def-name (if (and defining-form-p                  def-name (if (and defining-form-p
1130                                    (eq 'name (car (cdr spec)))                                    (eq 'name (car (cdr spec)))
1131                                    (eq 'symbol (edebug-next-token-class)))                                    (eq 'symbol (edebug-next-token-class)))
1132                               (edebug-original-read (current-buffer))))))                               (edebug-original-read (current-buffer))))))
# Line 1136  This controls how we read comma construc Line 1136  This controls how we read comma construc
1136         (if (or edebug-all-defs edebug-all-forms)         (if (or edebug-all-defs edebug-all-forms)
1137             ;; If it is a defining form and we are edebugging defs,             ;; If it is a defining form and we are edebugging defs,
1138             ;; then let edebug-list-form start it.             ;; then let edebug-list-form start it.
1139             (let ((cursor (edebug-new-cursor             (let ((cursor (edebug-new-cursor
1140                            (list (edebug-read-storing-offsets (current-buffer)))                            (list (edebug-read-storing-offsets (current-buffer)))
1141                            (list edebug-offsets))))                            (list edebug-offsets))))
1142               (car               (car
1143                (edebug-make-form-wrapper                (edebug-make-form-wrapper
1144                 cursor                 cursor
1145                 (edebug-before-offset cursor)                 (edebug-before-offset cursor)
1146                 (1- (edebug-after-offset cursor))                 (1- (edebug-after-offset cursor))
1147                 (list (cons (symbol-name def-kind) (cdr spec))))))                 (list (cons (symbol-name def-kind) (cdr spec))))))
1148    
# Line 1151  This controls how we read comma construc Line 1151  This controls how we read comma construc
1151           ;; This only works for defs with simple names.           ;; This only works for defs with simple names.
1152           (put def-name 'edebug (point-marker))           (put def-name 'edebug (point-marker))
1153           ;; Also nil out dependent defs.           ;; Also nil out dependent defs.
1154           '(mapcar (function           '(mapcar (function
1155                     (lambda (def)                     (lambda (def)
1156                       (put def-name 'edebug nil)))                       (put def-name 'edebug nil)))
1157                    (get def-name 'edebug-dependents))                    (get def-name 'edebug-dependents))
# Line 1159  This controls how we read comma construc Line 1159  This controls how we read comma construc
1159    
1160       ;; If all forms are being edebugged, explicitly wrap it.       ;; If all forms are being edebugged, explicitly wrap it.
1161       (edebug-all-forms       (edebug-all-forms
1162        (let ((cursor (edebug-new-cursor        (let ((cursor (edebug-new-cursor
1163                       (list (edebug-read-storing-offsets (current-buffer)))                       (list (edebug-read-storing-offsets (current-buffer)))
1164                       (list edebug-offsets))))                       (list edebug-offsets))))
1165          (edebug-make-form-wrapper          (edebug-make-form-wrapper
1166           cursor           cursor
1167           (edebug-before-offset cursor)           (edebug-before-offset cursor)
1168           (edebug-after-offset cursor)           (edebug-after-offset cursor)
1169           nil)))           nil)))
1170    
1171       ;; Not a defining form, and not edebugging.       ;; Not a defining form, and not edebugging.
# Line 1199  This controls how we read comma construc Line 1199  This controls how we read comma construc
1199    ;; 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'.
1200    ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.    ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
1201    ;; Do this after parsing since that may find a name.    ;; Do this after parsing since that may find a name.
1202    (setq edebug-def-name    (setq edebug-def-name
1203          (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))          (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
1204    `(edebug-enter    `(edebug-enter
1205      (quote ,edebug-def-name)      (quote ,edebug-def-name)
1206      ,(if edebug-inside-func        ,(if edebug-inside-func
1207           `(list           `(list
1208             ;; Doesn't work with more than one def-body!!             ;; Doesn't work with more than one def-body!!
1209             ;; But the list will just be reversed.             ;; But the list will just be reversed.
# Line 1214  This controls how we read comma construc Line 1214  This controls how we read comma construc
1214    
1215    
1216  (defvar edebug-form-begin-marker) ; the mark for def being instrumented  (defvar edebug-form-begin-marker) ; the mark for def being instrumented
1217      
1218  (defvar edebug-offset-index) ; the next available offset index.  (defvar edebug-offset-index) ; the next available offset index.
1219  (defvar edebug-offset-list) ; the list of offset positions.  (defvar edebug-offset-list) ; the list of offset positions.
1220    
# Line 1230  This controls how we read comma construc Line 1230  This controls how we read comma construc
1230    
1231  (defun edebug-make-before-and-after-form (before-index form after-index)  (defun edebug-make-before-and-after-form (before-index form after-index)
1232    ;; Return the edebug form for the current function at offset BEFORE-INDEX    ;; Return the edebug form for the current function at offset BEFORE-INDEX
1233    ;; given FORM.  Looks like:    ;; given FORM.  Looks like:
1234    ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)    ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
1235    ;; Also increment the offset index for subsequent use.    ;; Also increment the offset index for subsequent use.
1236    (list 'edebug-after    (list 'edebug-after
1237          (list 'edebug-before before-index)          (list 'edebug-before before-index)
1238          after-index form))          after-index form))
1239    
# Line 1244  This controls how we read comma construc Line 1244  This controls how we read comma construc
1244    
1245  (defun edebug-unwrap (sexp)  (defun edebug-unwrap (sexp)
1246    "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.
1247  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
1248  expressions; a `progn' form will be returned enclosing these forms."  expressions; a `progn' form will be returned enclosing these forms."
1249    (if (consp sexp)    (if (consp sexp)
1250        (cond        (cond
1251         ((eq 'edebug-after (car sexp))         ((eq 'edebug-after (car sexp))
1252          (nth 3 sexp))          (nth 3 sexp))
1253         ((eq 'edebug-enter (car sexp))         ((eq 'edebug-enter (car sexp))
# Line 1277  expressions; a `progn' form will be retu Line 1277  expressions; a `progn' form will be retu
1277    ;; Skip the first offset.    ;; Skip the first offset.
1278    (edebug-set-cursor cursor (edebug-cursor-expressions cursor)    (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
1279                       (cdr (edebug-cursor-offsets cursor)))                       (cdr (edebug-cursor-offsets cursor)))
1280    (edebug-make-form-wrapper    (edebug-make-form-wrapper
1281     cursor     cursor
1282     form-begin (1- form-end)     form-begin (1- form-end)
1283     speclist))     speclist))
1284    
# Line 1290  expressions; a `progn' form will be retu Line 1290  expressions; a `progn' form will be retu
1290    ;; 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.
1291    (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))
1292           ;; Set this marker before parsing.           ;; Set this marker before parsing.
1293           (edebug-form-begin-marker                       (edebug-form-begin-marker
1294            (if form-data-entry            (if form-data-entry
1295                (edebug-form-data-begin form-data-entry)                (edebug-form-data-begin form-data-entry)
1296              ;; Buffer must be current-buffer for this to work:              ;; Buffer must be current-buffer for this to work:
1297              (set-marker (make-marker) form-begin))))              (set-marker (make-marker) form-begin))))
# Line 1308  expressions; a `progn' form will be retu Line 1308  expressions; a `progn' form will be retu
1308            edebug-def-interactive            edebug-def-interactive
1309            edebug-inside-func;; whether wrapped code executes inside a function.            edebug-inside-func;; whether wrapped code executes inside a function.
1310            )            )
1311        
1312        (setq result        (setq result
1313              (if speclist              (if speclist
1314                  (edebug-match cursor speclist)                  (edebug-match cursor speclist)
1315    
1316                ;; else wrap as an enter-form.                ;; else wrap as an enter-form.
1317                (edebug-make-enter-wrapper (list (edebug-form cursor)))))                (edebug-make-enter-wrapper (list (edebug-form cursor)))))
1318        
1319        ;; 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.
1320        (setq edebug-def-name        (setq edebug-def-name
1321              (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))              (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
1322    
1323        ;; Add this def as a dependent of containing def.  Buggy.        ;; Add this def as a dependent of containing def.  Buggy.
1324        '(if (and edebug-containing-def-name        '(if (and edebug-containing-def-name
1325                  (not (get edebug-containing-def-name 'edebug-dependents)))                  (not (get edebug-containing-def-name 'edebug-dependents)))
1326             (put edebug-containing-def-name 'edebug-dependents             (put edebug-containing-def-name 'edebug-dependents
1327                  (cons edebug-def-name                  (cons edebug-def-name
1328                        (get edebug-containing-def-name                        (get edebug-containing-def-name
1329                             'edebug-dependents))))                             'edebug-dependents))))
1330    
1331        ;; Create a form-data-entry or modify existing entry's markers.        ;; Create a form-data-entry or modify existing entry's markers.
1332        ;; In the latter case, pointers to the entry remain eq.        ;; In the latter case, pointers to the entry remain eq.
1333        (if (not form-data-entry)        (if (not form-data-entry)
1334            (setq form-data-entry            (setq form-data-entry
1335                  (edebug-make-form-data-entry                  (edebug-make-form-data-entry
1336                   edebug-def-name                   edebug-def-name
1337                   edebug-form-begin-marker                   edebug-form-begin-marker
1338                   ;; Buffer must be current-buffer.                   ;; Buffer must be current-buffer.
1339                   (set-marker (make-marker) form-end)                   (set-marker (make-marker) form-end)
1340                   ))                   ))
1341          (edebug-set-form-data-entry          (edebug-set-form-data-entry
1342           form-data-entry edebug-def-name ;; in case name is changed           form-data-entry edebug-def-name ;; in case name is changed
1343           form-begin form-end))           form-begin form-end))
1344    
# Line 1359  expressions; a `progn' form will be retu Line 1359  expressions; a `progn' form will be retu
1359            (let ((window ;; Find the best window for this buffer.            (let ((window ;; Find the best window for this buffer.
1360                   (or (get-buffer-window (current-buffer))                   (or (get-buffer-window (current-buffer))
1361                       (selected-window))))                       (selected-window))))
1362              (setq edebug-top-window-data              (setq edebug-top-window-data
1363                    (cons window (window-start window)))))                    (cons window (window-start window)))))
1364    
1365        ;; Store the edebug data in symbol's property list.        ;; Store the edebug data in symbol's property list.
# Line 1382  expressions; a `progn' form will be retu Line 1382  expressions; a `progn' form will be retu
1382    
1383    
1384  (defun edebug-clear-coverage (name)  (defun edebug-clear-coverage (name)
1385    ;; Create initial coverage vector.      ;; Create initial coverage vector.
1386    ;; 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.
1387    (put name 'edebug-coverage    (put name 'edebug-coverage
1388         (make-vector (length edebug-offset-list) 'unknown)))         (make-vector (length edebug-offset-list) 'unknown)))
1389    
1390    
1391  (defun edebug-form (cursor)  (defun edebug-form (cursor)
1392    ;; Return the instrumented form for the following form.      ;; Return the instrumented form for the following form.
1393    ;; Add the point offsets to the edebug-offset-list for the form.    ;; Add the point offsets to the edebug-offset-list for the form.
1394    (let* ((form (edebug-top-element-required cursor "Expected form"))    (let* ((form (edebug-top-element-required cursor "Expected form"))
1395           (offset (edebug-top-offset cursor)))           (offset (edebug-top-offset cursor)))
# Line 1405  expressions; a `progn' form will be retu Line 1405  expressions; a `progn' form will be retu
1405                ;; Find out if this is a defining form from first symbol.                ;; Find out if this is a defining form from first symbol.
1406                ;; An indirect spec would not work here, yet.                ;; An indirect spec would not work here, yet.
1407                (if (and (consp spec) (eq '&define (car spec)))                (if (and (consp spec) (eq '&define (car spec)))
1408                    (edebug-defining-form                    (edebug-defining-form
1409                     new-cursor                     new-cursor
1410                     (car offset);; before the form                     (car offset);; before the form
1411                     (edebug-after-offset cursor)                     (edebug-after-offset cursor)
1412                     (cons (symbol-name head) (cdr spec)))                     (cons (symbol-name head) (cdr spec)))
1413                  ;; Wrap a regular form.                  ;; Wrap a regular form.
1414                  (edebug-make-before-and-after-form                  (edebug-make-before-and-after-form
1415                   (edebug-inc-offset (car offset))                   (edebug-inc-offset (car offset))
1416                   (edebug-list-form new-cursor)                   (edebug-list-form new-cursor)
1417                   ;; After processing the list form, the new-cursor is left                   ;; After processing the list form, the new-cursor is left
# Line 1488  expressions; a `progn' form will be retu Line 1488  expressions; a `progn' form will be retu
1488          (edebug-move-cursor cursor)          (edebug-move-cursor cursor)
1489          (edebug-interactive-p-name))          (edebug-interactive-p-name))
1490         (t         (t
1491          (cons head (edebug-list-form-args          (cons head (edebug-list-form-args
1492                      head (edebug-move-cursor cursor))))))                      head (edebug-move-cursor cursor))))))
1493    
1494       ((consp head)       ((consp head)
# Line 1510  expressions; a `progn' form will be retu Line 1510  expressions; a `progn' form will be retu
1510  (defconst edebug-max-depth 150)  ;; maximum number of matching recursions.  (defconst edebug-max-depth 150)  ;; maximum number of matching recursions.
1511    
1512    
1513  ;;; Failure to match  ;;; Failure to match
1514    
1515  ;; This throws to no-match, if there are higher alternatives.  ;; This throws to no-match, if there are higher alternatives.
1516  ;; 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 1555  expressions; a `progn' form will be retu Line 1555  expressions; a `progn' form will be retu
1555  (defun edebug-match-specs (cursor specs remainder-handler)  (defun edebug-match-specs (cursor specs remainder-handler)
1556    ;; Append results of matching the list of specs.    ;; Append results of matching the list of specs.
1557    ;; The first spec is handled and the remainder-handler handles the rest.    ;; The first spec is handled and the remainder-handler handles the rest.
1558    (let ((edebug-matching-depth    (let ((edebug-matching-depth
1559           (if (> edebug-matching-depth edebug-max-depth)           (if (> edebug-matching-depth edebug-max-depth)
1560               (error "too deep - perhaps infinite loop in spec?")               (error "too deep - perhaps infinite loop in spec?")
1561             (1+ edebug-matching-depth))))             (1+ edebug-matching-depth))))
1562      (cond      (cond
1563       ((null specs) nil)       ((null specs) nil)
1564      
1565       ;; Is the spec dotted?       ;; Is the spec dotted?
1566       ((atom specs)         ((atom specs)
1567        (let ((edebug-dotted-spec t));; Containing spec list was dotted.        (let ((edebug-dotted-spec t));; Containing spec list was dotted.
1568          (edebug-match-specs cursor (list specs) remainder-handler)))          (edebug-match-specs cursor (list specs) remainder-handler)))
1569    
# Line 1582  expressions; a `progn' form will be retu Line 1582  expressions; a `progn' form will be retu
1582    
1583       (t;; Process normally.       (t;; Process normally.
1584        (let* ((spec (car specs))        (let* ((spec (car specs))
1585               (rest)                     (rest)
1586               (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))               (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
1587          ;;(message "spec = %s  first char = %s" spec first-char) (sit-for 1)          ;;(message "spec = %s  first char = %s" spec first-char) (sit-for 1)
1588          (nconc          (nconc
# Line 1630  expressions; a `progn' form will be retu Line 1630  expressions; a `progn' form will be retu
1630    ;; Match a symbol spec.    ;; Match a symbol spec.
1631    (let* ((spec (get-edebug-spec symbol)))    (let* ((spec (get-edebug-spec symbol)))
1632      (cond      (cond
1633       (spec       (spec
1634        (if (consp spec)        (if (consp spec)
1635            ;; It is an indirect spec.            ;; It is an indirect spec.
1636            (edebug-match cursor spec)            (edebug-match cursor spec)
1637          ;; Otherwise it should be the symbol name of a function.          ;; Otherwise it should be the symbol name of a function.
1638          ;; 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.
1639          (funcall spec cursor)))          (funcall spec cursor)))
1640              
1641       ((null symbol)  ;; special case this.       ((null symbol)  ;; special case this.
1642        (edebug-match-nil cursor))        (edebug-match-nil cursor))
1643    
1644       ((fboundp symbol)                  ; is it a predicate?       ((fboundp symbol)                  ; is it a predicate?
1645        (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))        (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
1646          ;; Special case for edebug-`.          ;; Special case for edebug-`.
1647          (if (and (listp sexp) (eq (car sexp) ',))          (if (and (listp sexp) (eq (car sexp) ',))
# Line 1692  expressions; a `progn' form will be retu Line 1692  expressions; a `progn' form will be retu
1692    (if (null specs) (setq specs edebug-&rest))    (if (null specs) (setq specs edebug-&rest))
1693    ;; Reuse the &optional handler with this as the remainder handler.    ;; Reuse the &optional handler with this as the remainder handler.
1694    (edebug-&optional-wrapper cursor specs remainder-handler))    (edebug-&optional-wrapper cursor specs remainder-handler))
1695      
1696  (defun edebug-match-&rest (cursor specs)  (defun edebug-match-&rest (cursor specs)
1697    ;; Repeatedly use specs until failure.    ;; Repeatedly use specs until failure.
1698    (let ((edebug-&rest specs) ;; remember these    (let ((edebug-&rest specs) ;; remember these
# Line 1737  expressions; a `progn' form will be retu Line 1737  expressions; a `progn' form will be retu
1737        (edebug-no-match cursor "Unexpected"))        (edebug-no-match cursor "Unexpected"))
1738    ;; This means nothing matched, so it is OK.    ;; This means nothing matched, so it is OK.
1739    nil) ;; So, return nothing    nil) ;; So, return nothing
1740      
1741    
1742  (def-edebug-spec &key edebug-match-&key)  (def-edebug-spec &key edebug-match-&key)
1743    
# Line 1745  expressions; a `progn' form will be retu Line 1745  expressions; a `progn' form will be retu
1745    ;; Following specs must look like (<name> <spec>) ...    ;; Following specs must look like (<name> <spec>) ...
1746    ;; 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.
1747    ;; 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.
1748    (edebug-match-&rest    (edebug-match-&rest
1749     cursor     cursor
1750     (cons '&or     (cons '&or
1751           (mapcar (function (lambda (pair)           (mapcar (function (lambda (pair)
1752                               (vector (format ":%s" (car pair))                               (vector (format ":%s" (car pair))
1753                                       (car (cdr pair)))))                                       (car (cdr pair)))))
1754                   specs))))                   specs))))
1755    
# Line 1763  expressions; a `progn' form will be retu Line 1763  expressions; a `progn' form will be retu
1763  (defun edebug-match-list (cursor specs)  (defun edebug-match-list (cursor specs)
1764    ;; 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?
1765    (if edebug-dotted-spec    (if edebug-dotted-spec
1766        ;; After dotted spec but form did not contain dot,        ;; After dotted spec but form did not contain dot,
1767        ;; so match list spec elements as if spliced in.        ;; so match list spec elements as if spliced in.
1768        (prog1        (prog1
1769            (let ((edebug-dotted-spec))            (let ((edebug-dotted-spec))
# Line 1784  expressions; a `progn' form will be retu Line 1784  expressions; a `progn' form will be retu
1784              (edebug-move-cursor cursor)              (edebug-move-cursor cursor)
1785              (setq edebug-gate t)              (setq edebug-gate t)
1786              form)              form)
1787             (t             (t
1788              (error "Bad spec: %s" specs)))))              (error "Bad spec: %s" specs)))))
1789    
1790         ((listp form)         ((listp form)
1791          (prog1          (prog1
1792              (list (edebug-match-sublist              (list (edebug-match-sublist
1793                     ;; First offset is for the list form itself.                     ;; First offset is for the list form itself.
1794                     ;; Treat nil as empty list.                     ;; Treat nil as empty list.
1795                     (edebug-new-cursor form (cdr (edebug-top-offset cursor)))                     (edebug-new-cursor form (cdr (edebug-top-offset cursor)))
1796                     specs))                     specs))
1797            (edebug-move-cursor cursor)))            (edebug-move-cursor cursor)))
1798    
1799         ((and (eq 'vector spec) (vectorp form))         ((and (eq 'vector spec) (vectorp form))
1800          ;; Special case: match a vector with the specs.          ;; Special case: match a vector with the specs.
1801          (let ((result (edebug-match-sublist          (let ((result (edebug-match-sublist
1802                         (edebug-new-cursor                         (edebug-new-cursor
1803                          form (cdr (edebug-top-offset cursor)))                          form (cdr (edebug-top-offset cursor)))
1804                         (cdr specs))))                         (cdr specs))))
1805            (edebug-move-cursor cursor)            (edebug-move-cursor cursor)
1806            (list (apply 'vector result))))            (list (apply 'vector result))))
1807        
1808         (t (edebug-no-match cursor "Expected" specs)))         (t (edebug-no-match cursor "Expected" specs)))
1809        )))        )))
1810    
# Line 1815  expressions; a `progn' form will be retu Line 1815  expressions; a `progn' form will be retu
1815          ;;edebug-best-error          ;;edebug-best-error
1816          ;;edebug-error-point          ;;edebug-error-point
1817          )          )
1818      (prog1      (prog1
1819          ;; match with edebug-match-specs so edebug-best-error is not bound.          ;; match with edebug-match-specs so edebug-best-error is not bound.
1820          (edebug-match-specs cursor specs 'edebug-match-specs)          (edebug-match-specs cursor specs 'edebug-match-specs)
1821        (if (not (edebug-empty-cursor cursor))        (if (not (edebug-empty-cursor cursor))
1822            (if edebug-best-error            (if edebug-best-error
1823                (apply 'edebug-no-match cursor edebug-best-error)                (apply 'edebug-no-match cursor edebug-best-error)
1824              ;; A failed &rest or &optional spec may leave some args.              ;; A failed &rest or &optional spec may leave some args.
1825              (edebug-no-match cursor "Failed matching" specs)              (edebug-no-match cursor "Failed matching" specs)
# Line 1852  expressions; a `progn' form will be retu Line 1852  expressions; a `progn' form will be retu
1852    ;; 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
1853    ;; of the current list.  e.g. ("lambda" &define args def-body)    ;; of the current list.  e.g. ("lambda" &define args def-body)
1854     (edebug-make-form-wrapper     (edebug-make-form-wrapper
1855      cursor      cursor
1856      (edebug-before-offset cursor)      (edebug-before-offset cursor)
1857      ;; Find the last offset in the list.      ;; Find the last offset in the list.
1858      (let ((offsets (edebug-cursor-offsets cursor)))      (let ((offsets (edebug-cursor-offsets cursor)))
# Line 1864  expressions; a `progn' form will be retu Line 1864  expressions; a `progn' form will be retu
1864    ;; The expression must be a function.    ;; The expression must be a function.
1865    ;; This will match any list form that begins with a symbol    ;; This will match any list form that begins with a symbol
1866    ;; that has an edebug-form-spec beginning with &define.  In    ;; that has an edebug-form-spec beginning with &define.  In
1867    ;; practice, only lambda expressions should be used.      ;; practice, only lambda expressions should be used.
1868    ;; I could add a &lambda specification to avoid confusion.    ;; I could add a &lambda specification to avoid confusion.
1869    (let* ((sexp (edebug-top-element-required    (let* ((sexp (edebug-top-element-required
1870                  cursor "Expected lambda expression"))                  cursor "Expected lambda expression"))
1871           (offset (edebug-top-offset cursor))           (offset (edebug-top-offset cursor))
1872           (head (and (consp sexp) (car sexp)))           (head (and (consp sexp) (car sexp)))
# Line 1876  expressions; a `progn' form will be retu Line 1876  expressions; a `progn' form will be retu
1876      (if (and (consp spec) (eq '&define (car spec)))      (if (and (consp spec) (eq '&define (car spec)))
1877          (prog1          (prog1
1878              (list              (list
1879               (edebug-defining-form               (edebug-defining-form
1880                (edebug-new-cursor sexp offset)                (edebug-new-cursor sexp offset)
1881                (car offset);; before the sexp                (car offset);; before the sexp
1882                (edebug-after-offset cursor)                (edebug-after-offset cursor)
1883                (cons (symbol-name head) (cdr spec))))                (cons (symbol-name head) (cdr spec))))
1884            (edebug-move-cursor cursor))            (edebug-move-cursor cursor))
1885        (edebug-no-match cursor "Expected lambda expression")        (edebug-no-match cursor "Expected lambda expression")
# Line 2056  expressions; a `progn' form will be retu Line 2056  expressions; a `progn' form will be retu
2056    
2057  (def-edebug-spec \` (backquote-form))  (def-edebug-spec \` (backquote-form))
2058    
2059  ;; Supports quotes inside backquotes,  ;; Supports quotes inside backquotes,
2060  ;; but only at the top level inside unquotes.  ;; but only at the top level inside unquotes.
2061  (def-edebug-spec backquote-form  (def-edebug-spec backquote-form
2062    (&or    (&or
# Line 2121  expressions; a `progn' form will be retu Line 2121  expressions; a `progn' form will be retu
2121  ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)  ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
2122    
2123  (def-edebug-spec ad-dolist ((symbolp form &optional form) body))  (def-edebug-spec ad-dolist ((symbolp form &optional form) body))
2124  (def-edebug-spec defadvice  (def-edebug-spec defadvice
2125    (&define name   ;; thing being advised.    (&define name   ;; thing being advised.
2126             (name  ;; class is [&or "before" "around" "after"             (name  ;; class is [&or "before" "around" "after"
2127                    ;;               "activation" "deactivation"]                    ;;               "activation" "deactivation"]
2128              name  ;; name of advice              name  ;; name of advice
2129              &rest sexp  ;; optional position and flags              &rest sexp  ;; optional position and flags
2130              )              )
# Line 2232  error is signaled again." Line 2232  error is signaled again."
2232  (defun edebug-enter (edebug-function edebug-args edebug-body)  (defun edebug-enter (edebug-function edebug-args edebug-body)
2233    ;; Entering FUNC.  The arguments are ARGS, and the body is BODY.    ;; Entering FUNC.  The arguments are ARGS, and the body is BODY.
2234    ;; Setup edebug variables and evaluate BODY.  This function is called    ;; Setup edebug variables and evaluate BODY.  This function is called
2235    ;; when a function evaluated with edebug-eval-top-level-form is entered.      ;; when a function evaluated with edebug-eval-top-level-form is entered.
2236    ;; Return the result of BODY.    ;; Return the result of BODY.
2237    
2238    ;; Is this the first time we are entering edebug since    ;; Is this the first time we are entering edebug since
# Line 2240  error is signaled again." Line 2240  error is signaled again."
2240    ;; More precisely, this tests whether Edebug is currently active.    ;; More precisely, this tests whether Edebug is currently active.
2241    (if (not edebug-entered)    (if (not edebug-entered)
2242        (let ((edebug-entered t)        (let ((edebug-entered t)
2243              ;; Binding max-lisp-eval-depth here is OK,              ;; Binding max-lisp-eval-depth here is OK,
2244              ;; but not inside an unwind-protect.              ;; but not inside an unwind-protect.
2245              ;; Doing it here also keeps it from growing too large.              ;; Doing it here also keeps it from growing too large.
2246              (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??              (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
# Line 2269  error is signaled again." Line 2269  error is signaled again."
2269              (let (;; Don't keep reading from an executing kbd macro              (let (;; Don't keep reading from an executing kbd macro
2270                    ;; within edebug unless edebug-continue-kbd-macro is                    ;; within edebug unless edebug-continue-kbd-macro is
2271                    ;; non-nil.  Again, local binding may not be best.                    ;; non-nil.  Again, local binding may not be best.
2272                    (executing-kbd-macro                    (executing-kbd-macro
2273                     (if edebug-continue-kbd-macro executing-kbd-macro))                     (if edebug-continue-kbd-macro executing-kbd-macro))
2274    
2275                    ;; Don't get confused by the user's keymap changes.                    ;; Don't get confused by the user's keymap changes.
# Line 2283  error is signaled again." Line 2283  error is signaled again."
2283                    ;; This may be more than we need, however.                    ;; This may be more than we need, however.
2284                    (pre-command-hook nil)                    (pre-command-hook nil)
2285                    (post-command-hook nil))                    (post-command-hook nil))
2286                (setq edebug-execution-mode (or edebug-next-execution-mode                (setq edebug-execution-mode (or edebug-next-execution-mode
2287                                                edebug-initial-mode                                                edebug-initial-mode
2288                                                edebug-execution-mode)                                                edebug-execution-mode)
2289                      edebug-next-execution-mode nil)                      edebug-next-execution-mode nil)
2290                (edebug-enter edebug-function edebug-args edebug-body))                (edebug-enter edebug-function edebug-args edebug-body))
# Line 2293  error is signaled again." Line 2293  error is signaled again."
2293                  pre-command-hook edebug-outside-pre-command-hook                  pre-command-hook edebug-outside-pre-command-hook
2294                  post-command-hook edebug-outside-post-command-hook                  post-command-hook edebug-outside-post-command-hook
2295                  )))                  )))
2296        
2297      (let* ((edebug-data (get edebug-function 'edebug))      (let* ((edebug-data (get edebug-function 'edebug))
2298             (edebug-def-mark (car edebug-data)) ; mark at def start             (edebug-def-mark (car edebug-data)) ; mark at def start
2299             (edebug-freq-count (get edebug-function 'edebug-freq-count))             (edebug-freq-count (get edebug-function 'edebug-freq-count))
# Line 2317  error is signaled again." Line 2317  error is signaled again."
2317  (defun edebug-enter-trace (edebug-body)  (defun edebug-enter-trace (edebug-body)
2318    (let ((edebug-stack-depth (1+ edebug-stack-depth))    (let ((edebug-stack-depth (1+ edebug-stack-depth))
2319          edebug-result)          edebug-result)
2320      (edebug-print-trace-before      (edebug-print-trace-before
2321       (format "%s args: %s" edebug-function edebug-args))       (format "%s args: %s" edebug-function edebug-args))
2322      (prog1 (setq edebug-result (funcall edebug-body))      (prog1 (setq edebug-result (funcall edebug-body))
2323        (edebug-print-trace-after        (edebug-print-trace-after
# Line 2332  The result of BODY is also printed." Line 2332  The result of BODY is also printed."
2332           edebug-result)           edebug-result)
2333       (edebug-print-trace-before ,msg)       (edebug-print-trace-before ,msg)
2334       (prog1 (setq edebug-result (progn ,@body))       (prog1 (setq edebug-result (progn ,@body))
2335         (edebug-print-trace-after         (edebug-print-trace-after
2336          (format "%s result: %s" ,msg edebug-result)))))          (format "%s result: %s" ,msg edebug-result)))))
2337    
2338  (defun edebug-print-trace-before (msg)  (defun edebug-print-trace-before (msg)
# Line 2351  MSG is printed after `::::} '." Line 2351  MSG is printed after `::::} '."
2351    
2352  (defun edebug-slow-before (edebug-before-index)  (defun edebug-slow-before (edebug-before-index)
2353    ;; Debug current function given BEFORE position.    ;; Debug current function given BEFORE position.
2354    ;; Called from functions compiled with edebug-eval-top-level-form.      ;; Called from functions compiled with edebug-eval-top-level-form.
2355    ;; Return the before index.    ;; Return the before index.
2356    (setcar edebug-offset-indices edebug-before-index)    (setcar edebug-offset-indices edebug-before-index)
2357    
2358    ;; Increment frequency count    ;; Increment frequency count
2359    (aset edebug-freq-count edebug-before-index    (aset edebug-freq-count edebug-before-index
2360          (1+ (aref edebug-freq-count edebug-before-index)))          (1+ (aref edebug-freq-count edebug-before-index)))
2361    
# Line 2374  MSG is printed after `::::} '." Line 2374  MSG is printed after `::::} '."
2374    ;; Return VALUE.    ;; Return VALUE.
2375    (setcar edebug-offset-indices edebug-after-index)    (setcar edebug-offset-indices edebug-after-index)
2376    
2377    ;; Increment frequency count    ;; Increment frequency count
2378    (aset edebug-freq-count edebug-after-index    (aset edebug-freq-count edebug-after-index
2379          (1+ (aref edebug-freq-count edebug-after-index)))          (1+ (aref edebug-freq-count edebug-after-index)))
2380    (if edebug-test-coverage (edebug-update-coverage))    (if edebug-test-coverage (edebug-update-coverage))
# Line 2443  MSG is printed after `::::} '." Line 2443  MSG is printed after `::::} '."
2443    
2444  ;;;    (edebug-trace "exp: %s" edebug-value)  ;;;    (edebug-trace "exp: %s" edebug-value)
2445      ;; Test whether we should break.      ;; Test whether we should break.
2446      (setq edebug-break      (setq edebug-break
2447            (or edebug-global-break            (or edebug-global-break
2448                (and edebug-break-data                (and edebug-break-data
2449                     (or (not edebug-break-condition)                     (or (not edebug-break-condition)
# Line 2457  MSG is printed after `::::} '." Line 2457  MSG is printed after `::::} '."
2457                        (cdr (cdr edebug-data)))))                        (cdr (cdr edebug-data)))))
2458    
2459      ;; Display if mode is not go, continue, or Continue-fast      ;; Display if mode is not go, continue, or Continue-fast
2460      ;; or break, or input is pending,      ;; or break, or input is pending,
2461      (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))      (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
2462              edebug-break              edebug-break
2463              (edebug-input-pending-p))              (edebug-input-pending-p))
2464          (edebug-display))   ; <--------------- display          (edebug-display))   ; <--------------- display
2465        
2466      edebug-value      edebug-value
2467      ))      ))
2468    
# Line 2514  MSG is printed after `::::} '." Line 2514  MSG is printed after `::::} '."
2514          (edebug-outside-mark (edebug-mark))          (edebug-outside-mark (edebug-mark))
2515          edebug-outside-windows          ; window or screen configuration          edebug-outside-windows          ; window or screen configuration
2516          edebug-buffer-points          edebug-buffer-points
2517            
2518          edebug-eval-buffer              ; declared here so we can kill it below          edebug-eval-buffer              ; declared here so we can kill it below
2519          (edebug-eval-result-list (and edebug-eval-list          (edebug-eval-result-list (and edebug-eval-list
2520                                        (edebug-eval-result-list)))                                        (edebug-eval-result-list)))
# Line 2533  MSG is printed after `::::} '." Line 2533  MSG is printed after `::::} '."
2533            (if (not (buffer-name edebug-buffer))            (if (not (buffer-name edebug-buffer))
2534                (let ((debug-on-error nil))                (let ((debug-on-error nil))
2535                  (error "Buffer defining %s not found" edebug-function)))                  (error "Buffer defining %s not found" edebug-function)))
2536        
2537            (if (eq 'after edebug-arg-mode)            (if (eq 'after edebug-arg-mode)
2538                ;; Compute result string now before windows are modified.                ;; Compute result string now before windows are modified.
2539                (edebug-compute-previous-result edebug-value))                (edebug-compute-previous-result edebug-value))
2540    
2541            (if edebug-save-windows            (if edebug-save-windows
2542                ;; Save windows now before we modify them.                ;; Save windows now before we modify them.
2543                (setq edebug-outside-windows                (setq edebug-outside-windows
2544                      (edebug-current-windows edebug-save-windows)))                      (edebug-current-windows edebug-save-windows)))
2545        
2546            (if edebug-save-displayed-buffer-points            (if edebug-save-displayed-buffer-points
2547                (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))                (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
2548    
# Line 2558  MSG is printed after `::::} '." Line 2558  MSG is printed after `::::} '."
2558            (setcar edebug-window-data (selected-window))            (setcar edebug-window-data (selected-window))
2559    
2560            ;; Now display eval list, if any.            ;; Now display eval list, if any.
2561            ;; This is done after the pop to edebug-buffer            ;; This is done after the pop to edebug-buffer
2562            ;; so that buffer-window correspondence is correct after quitting.            ;; so that buffer-window correspondence is correct after quitting.
2563            (edebug-eval-display edebug-eval-result-list)            (edebug-eval-display edebug-eval-result-list)
2564            ;; The evaluation list better not have deleted edebug-window-data.            ;; The evaluation list better not have deleted edebug-window-data.
# Line 2567  MSG is printed after `::::} '." Line 2567  MSG is printed after `::::} '."
2567    
2568            (setq edebug-buffer-outside-point (point))            (setq edebug-buffer-outside-point (point))
2569            (goto-char edebug-point)            (goto-char edebug-point)
2570                
2571            (if (eq 'before edebug-arg-mode)            (if (eq 'before edebug-arg-mode)
2572                ;; Check whether positions are up-to-date.                ;; Check whether positions are up-to-date.
2573                ;; This assumes point is never before symbol.                ;; This assumes point is never before symbol.
2574                (if (not (memq (following-char) '(?\( ?\# ?\` )))                (if (not (memq (following-char) '(?\( ?\# ?\` )))
2575                    (let ((debug-on-error nil))                    (let ((debug-on-error nil))
2576                      (error "Source has changed - reevaluate definition of %s"                      (error "Source has changed - reevaluate definition of %s"
2577                             edebug-function)                             edebug-function)
2578                      )))                      )))
2579    
2580            (setcdr edebug-window-data            (setcdr edebug-window-data
2581                    (edebug-adjust-window (cdr edebug-window-data)))                    (edebug-adjust-window (cdr edebug-window-data)))
2582                
2583            ;; Test if there is input, not including keyboard macros.            ;; Test if there is input, not including keyboard macros.
2584            (if (edebug-input-pending-p)            (if (edebug-input-pending-p)
2585                (progn                (progn
2586                  (setq edebug-execution-mode 'step                  (setq edebug-execution-mode 'step
2587                        edebug-stop t)                        edebug-stop t)
# Line 2590  MSG is printed after `::::} '." Line 2590  MSG is printed after `::::} '."
2590                  ))                  ))
2591            ;; Now display arrow based on mode.            ;; Now display arrow based on mode.
2592            (edebug-overlay-arrow)            (edebug-overlay-arrow)
2593                
2594            (cond            (cond
2595             ((eq 'error edebug-arg-mode)             ((eq 'error edebug-arg-mode)
2596              ;; Display error message              ;; Display error message
# Line 2603  MSG is printed after `::::} '." Line 2603  MSG is printed after `::::} '."
2603             (edebug-break             (edebug-break
2604              (cond              (cond
2605               (edebug-global-break               (edebug-global-break
2606                (message "Global Break: %s => %s"                (message "Global Break: %s => %s"
2607                         edebug-global-break-condition                         edebug-global-break-condition
2608                         edebug-global-break-result))                         edebug-global-break-result))
2609               (edebug-break-condition               (edebug-break-condition
2610                (message "Break: %s => %s"                (message "Break: %s => %s"
2611                         edebug-break-condition                         edebug-break-condition
2612                         edebug-break-result))                         edebug-break-result))
2613               ((not (eq edebug-execution-mode 'Continue-fast))               ((not (eq edebug-execution-mode 'Continue-fast))
2614                (message "Break"))                (message "Break"))
# Line 2623  MSG is printed after `::::} '." Line 2623  MSG is printed after `::::} '."
2623                           (not (eq edebug-execution-mode 'Continue-fast)))                           (not (eq edebug-execution-mode 'Continue-fast)))
2624                      (sit-for 1))        ; Show break message.                      (sit-for 1))        ; Show break message.
2625                  (edebug-previous-result)))                  (edebug-previous-result)))
2626        
2627            (cond            (cond
2628             (edebug-break             (edebug-break
2629              (cond              (cond
# Line 2636  MSG is printed after `::::} '." Line 2636  MSG is printed after `::::} '."
2636             ((eq edebug-execution-mode 'Trace-fast)             ((eq edebug-execution-mode 'Trace-fast)
2637              (edebug-sit-for 0))         ; Force update and continue.              (edebug-sit-for 0))         ; Force update and continue.
2638             )             )
2639        
2640            (unwind-protect            (unwind-protect
2641                (if (or edebug-stop                (if (or edebug-stop
2642                        (memq edebug-execution-mode '(step next))                        (memq edebug-execution-mode '(step next))
2643                        (eq edebug-arg-mode 'error))                        (eq edebug-arg-mode 'error))
2644                    (progn                    (progn
2645                      ;; (setq edebug-execution-mode 'step)                      ;; (setq edebug-execution-mode 'step)
2646                      ;; (edebug-overlay-arrow)   ; This doesn't always show up.                      ;; (edebug-overlay-arrow)   ; This doesn't always show up.
# Line 2661  MSG is printed after `::::} '." Line 2661  MSG is printed after `::::} '."
2661              (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))              (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
2662              (if edebug-trace-window              (if edebug-trace-window
2663                  (setq edebug-trace-window-start                  (setq edebug-trace-window-start
2664                        (and edebug-trace-window                        (and edebug-trace-window
2665                             (window-start edebug-trace-window))))                             (window-start edebug-trace-window))))
2666    
2667              ;; Restore windows before continuing.              ;; Restore windows before continuing.
# Line 2677  MSG is printed after `::::} '." Line 2677  MSG is printed after `::::} '."
2677    
2678                    ;; Unrestore trace window's window-point.                    ;; Unrestore trace window's window-point.
2679                    (if edebug-trace-window                    (if edebug-trace-window
2680                        (set-window-start edebug-trace-window                        (set-window-start edebug-trace-window
2681                                          edebug-trace-window-start))                                          edebug-trace-window-start))
2682    
2683                    ;; Unrestore edebug-buffer's window-start, if displayed.                    ;; Unrestore edebug-buffer's window-start, if displayed.
2684                    (let ((window (car edebug-window-data)))                    (let ((window (car edebug-window-data)))
2685                      (if (and window (edebug-window-live-p window)                      (if (and window (edebug-window-live-p window)
2686                               (eq (window-buffer) edebug-buffer))                               (eq (window-buffer) edebug-buffer))
2687                          (progn                          (progn
2688                            (set-window-start window (cdr edebug-window-data)                            (set-window-start window (cdr edebug-window-data)
2689                                              'no-force)                                              'no-force)
2690                            ;; Unrestore edebug-buffer's window-point.                            ;; Unrestore edebug-buffer's window-point.
2691                            ;; Needed in addition to setting the buffer point                            ;; Needed in addition to setting the buffer point
# Line 2720  MSG is printed after `::::} '." Line 2720  MSG is printed after `::::} '."
2720            ;; None of the following is done if quit or signal occurs.            ;; None of the following is done if quit or signal occurs.
2721    
2722            ;; Restore edebug-buffer's outside point.            ;; Restore edebug-buffer's outside point.
2723            ;;    (edebug-trace "restore edebug-buffer point: %s"            ;;    (edebug-trace "restore edebug-buffer point: %s"
2724            ;;              edebug-buffer-outside-point)            ;;              edebug-buffer-outside-point)
2725            (let ((current-buffer (current-buffer)))            (let ((current-buffer (current-buffer)))
2726              (set-buffer edebug-buffer)              (set-buffer edebug-buffer)
# Line 2746  MSG is printed after `::::} '." Line 2746  MSG is printed after `::::} '."
2746  ;; Dynamically declared unbound vars  ;; Dynamically declared unbound vars
2747  (defvar edebug-outside-match-data) ; match data outside of edebug  (defvar edebug-outside-match-data) ; match data outside of edebug
2748  (defvar edebug-backtrace-buffer) ; each recursive edit gets its own  (defvar edebug-backtrace-buffer) ; each recursive edit gets its own
2749  (defvar edebug-inside-windows)  (defvar edebug-inside-windows)
2750  (defvar edebug-interactive-p)  (defvar edebug-interactive-p)
2751    
2752  (defvar edebug-outside-map)  (defvar edebug-outside-map)
# Line 2830  MSG is printed after `::::} '." Line 2830  MSG is printed after `::::} '."
2830                ;; Declare global values local but using the same global value.                ;; Declare global values local but using the same global value.
2831                ;; We could set these to the values for previous edebug call.                ;; We could set these to the values for previous edebug call.
2832                (last-command-char last-command-char)                (last-command-char last-command-char)
2833                (last-command last-command)                (last-command last-command)
2834                (this-command this-command)                (this-command this-command)
2835                (last-input-char last-input-char)                (last-input-char last-input-char)
2836    
# Line 2851  MSG is printed after `::::} '." Line 2851  MSG is printed after `::::} '."
2851                (debug-on-quit edebug-outside-debug-on-quit)                (debug-on-quit edebug-outside-debug-on-quit)
2852    
2853                ;; Don't keep defining a kbd macro.                ;; Don't keep defining a kbd macro.
2854                (defining-kbd-macro                (defining-kbd-macro
2855                  (if edebug-continue-kbd-macro defining-kbd-macro))                  (if edebug-continue-kbd-macro defining-kbd-macro))
2856    
2857                ;; others??                ;; others??
# Line 2897  MSG is printed after `::::} '." Line 2897  MSG is printed after `::::} '."
2897              ));; inner let              ));; inner let
2898    
2899        ;; Reset global vars to outside values, in case they have been changed.        ;; Reset global vars to outside values, in case they have been changed.
2900        (setq        (setq
2901         last-command-char edebug-outside-last-command-char         last-command-char edebug-outside-last-command-char
2902         last-command-event edebug-outside-last-command-event         last-command-event edebug-outside-last-command-event
2903         last-command edebug-outside-last-command         last-command edebug-outside-last-command
# Line 2922  MSG is printed after `::::} '." Line 2922  MSG is printed after `::::} '."
2922    
2923  (defun edebug-adjust-window (old-start)  (defun edebug-adjust-window (old-start)
2924    ;; If pos is not visible, adjust current window to fit following context.    ;; If pos is not visible, adjust current window to fit following context.
2925  ;;;  (message "window: %s old-start: %s window-start: %s pos: %s"  ;;;  (message "window: %s old-start: %s window-start: %s pos: %s"
2926  ;;;        (selected-window) old-start (window-start) (point)) (sit-for 5)  ;;;        (selected-window) old-start (window-start) (point)) (sit-for 5)
2927    (if (not (pos-visible-in-window-p))    (if (not (pos-visible-in-window-p))
2928        (progn        (progn
# Line 2942  MSG is printed after `::::} '." Line 2942  MSG is printed after `::::} '."
2942             (beginning-of-line)             (beginning-of-line)
2943             (point)))))))             (point)))))))
2944    (window-start))    (window-start))
2945      
2946    
2947    
2948  (defconst edebug-arrow-alist  (defconst edebug-arrow-alist
# Line 2959  MSG is printed after `::::} '." Line 2959  MSG is printed after `::::} '."
2959    
2960  (defun edebug-overlay-arrow ()  (defun edebug-overlay-arrow ()
2961    ;; Set up the overlay arrow at beginning-of-line in current buffer.    ;; Set up the overlay arrow at beginning-of-line in current buffer.
2962    ;; The arrow string is derived from edebug-arrow-alist and    ;; The arrow string is derived from edebug-arrow-alist and
2963    ;; edebug-execution-mode.    ;; edebug-execution-mode.
2964    (let ((pos (save-excursion (beginning-of-line) (point))))    (let ((pos (save-excursion (beginning-of-line) (point))))
2965      (setq overlay-arrow-string      (setq overlay-arrow-string
# Line 2987  configurations become the same as the cu Line 2987  configurations become the same as the cu
2987       (setq edebug-inside-windows (edebug-current-windows t))       (setq edebug-inside-windows (edebug-current-windows t))
2988       (edebug-set-windows edebug-outside-windows)       (edebug-set-windows edebug-outside-windows)
2989       ,@body;; Code to change edebug-save-windows       ,@body;; Code to change edebug-save-windows
2990       (setq edebug-outside-windows (edebug-current-windows       (setq edebug-outside-windows (edebug-current-windows
2991                                     edebug-save-windows))                                     edebug-save-windows))
2992       ;; Problem: what about outside windows that are deleted inside?       ;; Problem: what about outside windows that are deleted inside?
2993       (edebug-set-windows edebug-inside-windows)))       (edebug-set-windows edebug-inside-windows)))
2994    
2995  (defun edebug-toggle-save-selected-window ()  (defun edebug-toggle-save-selected-window ()
2996    "Toggle the saving and restoring of the selected window.    "Toggle the saving and restoring of the selected window.
2997  Also, each time you toggle it on, the inside and outside window  Also, each time you toggle it on, the inside and outside window
2998  configurations become the same as the current configuration."  configurations become the same as the current configuration."
2999    (interactive)    (interactive)
# Line 3046  Otherwise, toggle for all windows." Line 3046  Otherwise, toggle for all windows."
3046    (interactive)    (interactive)
3047    (if (not edebug-active)    (if (not edebug-active)
3048        (error "Edebug is not active"))        (error "Edebug is not active"))
3049    (setq edebug-inside-windows    (setq edebug-inside-windows
3050          (edebug-current-windows edebug-save-windows))          (edebug-current-windows edebug-save-windows))
3051    (edebug-set-windows edebug-outside-windows)    (edebug-set-windows edebug-outside-windows)
3052    (goto-char edebug-outside-point)    (goto-char edebug-outside-point)
# Line 3066  The default is one second." Line 3066  The default is one second."
3066      (save-window-excursion      (save-window-excursion
3067        (edebug-pop-to-buffer edebug-outside-buffer)        (edebug-pop-to-buffer edebug-outside-buffer)
3068        (goto-char edebug-outside-point)        (goto-char edebug-outside-point)
3069        (message "Current buffer: %s Point: %s Mark: %s"        (message "Current buffer: %s Point: %s Mark: %s"
3070                 (current-buffer) (point)                 (current-buffer) (point)
3071                 (if (marker-buffer (edebug-mark-marker))                 (if (marker-buffer (edebug-mark-marker))
3072                     (marker-position (edebug-mark-marker)) "<not set>"))                     (marker-position (edebug-mark-marker)) "<not set>"))
3073        (edebug-sit-for arg)        (edebug-sit-for arg)
3074        (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))        (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
3075    
3076    
3077  ;; 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
3078  ;; display list.  Still need to use this list in edebug-display.  ;; display list.  Still need to use this list in edebug-display.
3079    
3080  '(defvar edebug-display-buffer-list nil  '(defvar edebug-display-buffer-list nil
# Line 3135  The default is one second." Line 3135  The default is one second."
3135          (let* ((edebug-def-name (car edebug-stop-point))          (let* ((edebug-def-name (car edebug-stop-point))
3136                 (index (cdr edebug-stop-point))                 (index (cdr edebug-stop-point))
3137                 (edebug-data (get edebug-def-name 'edebug))                 (edebug-data (get edebug-def-name 'edebug))
3138                  
3139                 ;; pull out parts of edebug-data                 ;; pull out parts of edebug-data
3140                 (edebug-def-mark (car edebug-data))                 (edebug-def-mark (car edebug-data))
3141                 (edebug-breakpoints (car (cdr edebug-data)))                 (edebug-breakpoints (car (cdr edebug-data)))
# Line 3154  The default is one second." Line 3154  The default is one second."
3154                        (car edebug-breakpoints)))                        (car edebug-breakpoints)))
3155                (goto-char (+ edebug-def-mark                (goto-char (+ edebug-def-mark
3156                              (aref offset-vector (car breakpoint))))                              (aref offset-vector (car breakpoint))))
3157                  
3158                (message "%s"                (message "%s"
3159                         (concat (if (nth 2 breakpoint)                         (concat (if (nth 2 breakpoint)
3160                                     "Temporary " "")                                     "Temporary " "")
# Line 3170  The default is one second." Line 3170  The default is one second."
3170    "Modify the breakpoint for the form at point or after it according    "Modify the breakpoint for the form at point or after it according
3171  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.
3172  If CONDITION or TEMPORARY are non-nil, add those attributes to  If CONDITION or TEMPORARY are non-nil, add those attributes to
3173  the breakpoint.  "    the breakpoint.  "
3174    (let ((edebug-stop-point (edebug-find-stop-point)))    (let ((edebug-stop-point (edebug-find-stop-point)))
3175      (if edebug-stop-point      (if edebug-stop-point
3176          (let* ((edebug-def-name (car edebug-stop-point))          (let* ((edebug-def-name (car edebug-stop-point))
3177                 (index (cdr edebug-stop-point))                 (index (cdr edebug-stop-point))
3178                 (edebug-data (get edebug-def-name 'edebug))                 (edebug-data (get edebug-def-name 'edebug))
3179                  
3180                 ;; pull out parts of edebug-data                 ;; pull out parts of edebug-data
3181                 (edebug-def-mark (car edebug-data))                 (edebug-def-mark (car edebug-data))
3182                 (edebug-breakpoints (car (cdr edebug-data)))                 (edebug-breakpoints (car (cdr edebug-data)))
# Line 3200  the breakpoint.  " Line 3200  the breakpoint.  "
3200              (if present              (if present
3201                  (message "Breakpoint unset in %s" edebug-def-name)                  (message "Breakpoint unset in %s" edebug-def-name)
3202                (message "No breakpoint here")))                (message "No breakpoint here")))
3203              
3204            (setcar (cdr edebug-data) edebug-breakpoints)            (setcar (cdr edebug-data) edebug-breakpoints)
3205            (goto-char (+ edebug-def-mark (aref offset-vector index)))            (goto-char (+ edebug-def-mark (aref offset-vector index)))
3206            ))))            ))))
# Line 3223  With prefix argument, make it a temporar Line 3223  With prefix argument, make it a temporar
3223  The condition is evaluated in the outside context.  The condition is evaluated in the outside context.
3224  With prefix argument, make it a temporary breakpoint."  With prefix argument, make it a temporary breakpoint."
3225    ;; (interactive "P\nxCondition: ")    ;; (interactive "P\nxCondition: ")
3226    (interactive    (interactive
3227     (list     (list
3228      current-prefix-arg      current-prefix-arg
3229      ;; Edit previous condition as follows, but it is cumbersome:      ;; Edit previous condition as follows, but it is cumbersome:
# Line 3235  With prefix argument, make it a temporar Line 3235  With prefix argument, make it a temporar
3235                   (edebug-breakpoints (car (cdr edebug-data)))                   (edebug-breakpoints (car (cdr edebug-data)))
3236                   (edebug-break-data (assq index edebug-breakpoints))                   (edebug-break-data (assq index edebug-breakpoints))
3237                   (edebug-break-condition (car (cdr edebug-break-data))))                   (edebug-break-condition (car (cdr edebug-break-data))))
3238              (read-minibuffer              (read-minibuffer
3239               (format "Condition in %s: " edebug-def-name)               (format "Condition in %s: " edebug-def-name)
3240               (if edebug-break-condition               (if edebug-break-condition
3241                   (format "%s" edebug-break-condition)                   (format "%s" edebug-break-condition)
# Line 3244  With prefix argument, make it a temporar Line 3244  With prefix argument, make it a temporar
3244    
3245    
3246  (defun edebug-set-global-break-condition (expression)  (defun edebug-set-global-break-condition (expression)
3247    (interactive (list (read-minibuffer    (interactive (list (read-minibuffer
3248                        "Global Condition: "                        "Global Condition: "
3249                        (format "%s" edebug-global-break-condition))))                        (format "%s" edebug-global-break-condition))))
3250    (setq edebug-global-break-condition expression))    (setq edebug-global-break-condition expression))
3251    
# Line 3336  Useful for exiting from trace or continu Line 3336  Useful for exiting from trace or continu
3336  '(defun edebug-forward ()  '(defun edebug-forward ()
3337    "Proceed to the exit of the next expression to be evaluated."    "Proceed to the exit of the next expression to be evaluated."
3338    (interactive)    (interactive)
3339    (edebug-set-mode    (edebug-set-mode
3340     'forward "Forward"     'forward "Forward"
3341     "Edebug will stop after exiting the next expression."))     "Edebug will stop after exiting the next expression."))
3342    
# Line 3392  go to the end of the last sexp, or if th Line 3392  go to the end of the last sexp, or if th
3392       ((consp func-marker)       ((consp func-marker)
3393        (message "%s is already instrumented." func)        (message "%s is already instrumented." func)
3394        func)        func)
3395       (t       (t
3396        ;; We could try harder, e.g. do a tags search.        ;; We could try harder, e.g. do a tags search.
3397        (error "Don't know where %s is defined" func)        (error "Don't know where %s is defined" func)
3398        nil))))        nil))))
3399    
3400  (defun edebug-instrument-callee ()  (defun edebug-instrument-callee ()
3401    "Instrument the definition of the function or macro about to be called.      "Instrument the definition of the function or macro about to be called.
3402  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.
3403  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
3404  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 3416  function or macro is called, Edebug will Line 3416  function or macro is called, Edebug will
3416    
3417    
3418  (defun edebug-step-in ()  (defun edebug-step-in ()
3419    "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.
3420  This first does `edebug-instrument-callee' to ensure that it is  This first does `edebug-instrument-callee' to ensure that it is
3421  instrumented.  Then it does `edebug-on-entry' and switches to `go' mode."  instrumented.  Then it does `edebug-on-entry' and switches to `go' mode."
3422    (interactive)    (interactive)
3423    (let ((func (edebug-instrument-callee)))    (let ((func (edebug-instrument-callee)))
# Line 3438  cancelled the first time the function is Line 3438  cancelled the first time the function is
3438    (interactive "aEdebug on entry to: ")    (interactive "aEdebug on entry to: ")
3439    (put function 'edebug-on-entry nil))    (put function 'edebug-on-entry nil))
3440    
3441        
3442  (if (not (fboundp 'edebug-original-debug-on-entry))  (if (not (fboundp 'edebug-original-debug-on-entry))
3443      (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))      (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
3444  '(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 3530  Return the result of the last expression Line 3530  Return the result of the last expression
3530    `(save-excursion                      ; of current-buffer    `(save-excursion                      ; of current-buffer
3531       (if edebug-save-windows       (if edebug-save-windows
3532           (progn           (progn
3533             ;; After excursion, we will             ;; After excursion, we will
3534             ;; restore to current window configuration.             ;; restore to current window configuration.
3535             (setq edebug-inside-windows             (setq edebug-inside-windows
3536                   (edebug-current-windows edebug-save-windows))                   (edebug-current-windows edebug-save-windows))
# Line 3582  Return the result of the last expression Line 3582  Return the result of the last expression
3582               (edebug-set-windows edebug-inside-windows))               (edebug-set-windows edebug-inside-windows))
3583    
3584           ;; Save values that may have been changed.           ;; Save values that may have been changed.
3585           (setq           (setq
3586            edebug-outside-last-command-char last-command-char            edebug-outside-last-command-char last-command-char
3587            edebug-outside-last-command-event last-command-event            edebug-outside-last-command-event last-command-event
3588            edebug-outside-last-command last-command            edebug-outside-last-command last-command
# Line 3618  Return the result of the last expression Line 3618  Return the result of the last expression
3618      (eval edebug-expr)))      (eval edebug-expr)))
3619    
3620  (defun edebug-safe-eval (edebug-expr)  (defun edebug-safe-eval (edebug-expr)
3621    ;; Evaluate EXPR safely.    ;; Evaluate EXPR safely.
3622    ;; If there is an error, a string is returned describing the error.    ;; If there is an error, a string is returned describing the error.
3623    (condition-case edebug-err    (condition-case edebug-err
3624        (edebug-eval edebug-expr)        (edebug-eval edebug-expr)
3625      (error (edebug-format "%s: %s"  ;; could      (error (edebug-format "%s: %s"  ;; could
3626                            (get (car edebug-err) 'error-message)                            (get (car edebug-err) 'error-message)
3627                            (car (cdr edebug-err))))))                            (car (cdr edebug-err))))))
3628    
# Line 3667  Return the result of the last expression Line 3667  Return the result of the last expression
3667  (defun edebug-report-error (edebug-value)  (defun edebug-report-error (edebug-value)
3668    ;; Print an error message like command level does.    ;; Print an error message like command level does.
3669    ;; This also prints the error name if it has no error-message.    ;; This also prints the error name if it has no error-message.
3670    (message "%s: %s"    (message "%s: %s"
3671             (or (get (car edebug-value) 'error-message)             (or (get (car edebug-value) 'error-message)
3672                 (format "peculiar error (%s)" (car edebug-value)))                 (format "peculiar error (%s)" (car edebug-value)))
3673             (mapconcat (function (lambda (edebug-arg)             (mapconcat (function (lambda (edebug-arg)
3674                                    ;; continuing after an error may                                    ;; continuing after an error may
3675                                    ;; complain about edebug-arg. why??                                    ;; complain about edebug-arg. why??
3676                                    (prin1-to-string edebug-arg)))                                    (prin1-to-string edebug-arg)))
# Line 3680  Return the result of the last expression Line 3680  Return the result of the last expression
3680  (defvar print-level nil)  (defvar print-level nil)
3681  (defvar print-circle nil)  (defvar print-circle nil)
3682  (defvar print-readably) ;; defined by lemacs  (defvar print-readably) ;; defined by lemacs
3683  ;; Alternatively, we could change the definition of  ;; Alternatively, we could change the definition of
3684  ;; edebug-safe-prin1-to-string to only use these if defined.  ;; edebug-safe-prin1-to-string to only use these if defined.
3685    
3686  (defun edebug-safe-prin1-to-string (value)  (defun edebug-safe-prin1-to-string (value)
# Line 3699  Return the result of the last expression Line 3699  Return the result of the last expression
3699              (format "Result: %s = %s" edebug-previous-value              (format "Result: %s = %s" edebug-previous-value
3700                      (single-key-description edebug-previous-value))                      (single-key-description edebug-previous-value))
3701            (if edebug-unwrap-results            (if edebug-unwrap-results
3702                (setq edebug-previous-value                (setq edebug-previous-value
3703                      (edebug-unwrap* edebug-previous-value)))                      (edebug-unwrap* edebug-previous-value)))
3704            (concat "Result: "            (concat "Result: "
3705                    (edebug-safe-prin1-to-string edebug-previous-value)))))                    (edebug-safe-prin1-to-string edebug-previous-value)))))
3706    
3707  (defun edebug-previous-result ()  (defun edebug-previous-result ()
# Line 3712  Return the result of the last expression Line 3712  Return the result of the last expression
3712  ;;; Read, Eval and Print  ;;; Read, Eval and Print
3713    
3714  (defun edebug-eval-expression (edebug-expr)  (defun edebug-eval-expression (edebug-expr)
3715    "Evaluate an expression in the outside environment.      "Evaluate an expression in the outside environment.
3716  If interactive, prompt for the expression.  If interactive, prompt for the expression.
3717  Print result in minibuffer."  Print result in minibuffer."
3718    (interactive "xEval: ")    (interactive "xEval: ")
# Line 3728  print value in minibuffer." Line 3728  print value in minibuffer."
3728    (edebug-eval-expression (edebug-last-sexp)))    (edebug-eval-expression (edebug-last-sexp)))
3729    
3730  (defun edebug-eval-print-last-sexp ()  (defun edebug-eval-print-last-sexp ()
3731    "Evaluate sexp before point in the outside environment;    "Evaluate sexp before point in the outside environment;
3732  print value into current buffer."  print value into current buffer."
3733    (interactive)    (interactive)
3734    (let* ((edebug-form (edebug-last-sexp))    (let* ((edebug-form (edebug-last-sexp))
3735           (edebug-result-string           (edebug-result-string
3736            (edebug-outside-excursion            (edebug-outside-excursion
3737             (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))             (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
3738           (standard-output (current-buffer)))           (standard-output (current-buffer)))
3739      (princ "\n")      (princ "\n")
# Line 3742  print value into current buffer." Line 3742  print value into current buffer."
3742      (princ "\n")      (princ "\n")
3743      ))      ))
3744    
3745  ;;; Edebug Minor Mode  ;;; Edebug Minor Mode
3746    
3747  ;; Global GUD bindings for all emacs-lisp-mode buffers.  ;; Global GUD bindings for all emacs-lisp-mode buffers.
3748  (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)
3749  (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)
3750  (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)
3751  (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)
3752        
3753    
3754  (defvar edebug-mode-map nil)  (defvar edebug-mode-map nil)
3755  (if edebug-mode-map  (if edebug-mode-map
# Line 3773  print value into current buffer." Line 3773  print value into current buffer."
3773      (define-key edebug-mode-map "I" 'edebug-instrument-callee)      (define-key edebug-mode-map "I" 'edebug-instrument-callee)
3774      (define-key edebug-mode-map "i" 'edebug-step-in)      (define-key edebug-mode-map "i" 'edebug-step-in)
3775      (define-key edebug-mode-map "o" 'edebug-step-out)      (define-key edebug-mode-map "o" 'edebug-step-out)
3776        
3777      ;; quitting and stopping      ;; quitting and stopping
3778      (define-key edebug-mode-map "q" 'top-level)      (define-key edebug-mode-map "q" 'top-level)
3779      (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)      (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
# Line 3786  print value into current buffer." Line 3786  print value into current buffer."
3786      (define-key edebug-mode-map "B" 'edebug-next-breakpoint)      (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
3787      (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)      (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
3788      (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)      (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
3789        
3790      ;; evaluation      ;; evaluation
3791      (define-key edebug-mode-map "r" 'edebug-previous-result)      (define-key edebug-mode-map "r" 'edebug-previous-result)
3792      (define-key edebug-mode-map "e" 'edebug-eval-expression)      (define-key edebug-mode-map "e" 'edebug-eval-expression)
3793      (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)
3794      (define-key edebug-mode-map "E" 'edebug-visit-eval-list)      (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
3795        
3796      ;; views      ;; views
3797      (define-key edebug-mode-map "w" 'edebug-where)      (define-key edebug-mode-map "w" 'edebug-where)
3798      (define-key edebug-mode-map "v" 'edebug-view-outside)  ;; maybe obsolete??      (define-key edebug-mode-map "v" 'edebug-view-outside)  ;; maybe obsolete??
# Line 3803  print value into current buffer." Line 3803  print value into current buffer."
3803      ;; misc      ;; misc
3804      (define-key edebug-mode-map "?" 'edebug-help)      (define-key edebug-mode-map "?" 'edebug-help)
3805      (define-key edebug-mode-map "d" 'edebug-backtrace)      (define-key edebug-mode-map "d" 'edebug-backtrace)
3806        
3807      (define-key edebug-mode-map "-" 'negative-argument)      (define-key edebug-mode-map "-" 'negative-argument)
3808    
3809      ;; statistics      ;; statistics
# Line 3816  print value into current buffer." Line 3816  print value into current buffer."
3816    
3817      (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)      (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)
3818      (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)      (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)
3819      (define-key edebug-mode-map "\C-c\C-t"      (define-key edebug-mode-map "\C-c\C-t"
3820        (function (lambda () (edebug-set-breakpoint t))))        (function (lambda () (edebug-set-breakpoint t))))
3821      (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)      (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)
3822      ))      ))
# Line 3873  print value into current buffer." Line 3873  print value into current buffer."
3873    
3874  In addition to all Emacs Lisp commands (except those that modify the  In addition to all Emacs Lisp commands (except those that modify the
3875  buffer) there are local and global key bindings to several Edebug  buffer) there are local and global key bindings to several Edebug
3876  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]
3877  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.
3878    
3879  Also see bindings for the eval list buffer, *edebug*.  Also see bindings for the eval list buffer, *edebug*.
# Line 3914  edebug-global-break-condition Line 3914  edebug-global-break-condition
3914    ;; Assumes in outside environment.    ;; Assumes in outside environment.
3915    ;; Don't do any edebug things now.    ;; Don't do any edebug things now.
3916    (let ((edebug-execution-mode 'Go-nonstop)    (let ((edebug-execution-mode 'Go-nonstop)
3917          (edebug-trace nil))          (edebug-trace nil))
3918      (mapcar 'edebug-safe-eval edebug-eval-list)))      (mapcar 'edebug-safe-eval edebug-eval-list)))
3919    
3920  (defun edebug-eval-display-list (edebug-eval-result-list)  (defun edebug-eval-display-list (edebug-eval-result-list)
# Line 3978  May only be called from within edebug-re Line 3978  May only be called from within edebug-re
3978          (progn          (progn
3979            (forward-sexp 1)            (forward-sexp 1)
3980            (setq new-list (cons (edebug-last-sexp) new-list))))            (setq new-list (cons (edebug-last-sexp) new-list))))
3981        
3982      (while (re-search-forward "^;" nil t)      (while (re-search-forward "^;" nil t)
3983        (forward-line 1)        (forward-line 1)
3984        (skip-chars-forward " \t\n\r")        (skip-chars-forward " \t\n\r")
# Line 3987  May only be called from within edebug-re Line 3987  May only be called from within edebug-re
3987            (progn            (progn
3988              (forward-sexp 1)              (forward-sexp 1)
3989              (setq new-list (cons (edebug-last-sexp) new-list)))))              (setq new-list (cons (edebug-last-sexp) new-list)))))
3990        
3991      (setq edebug-eval-list (nreverse new-list))      (setq edebug-eval-list (nreverse new-list))
3992      (edebug-eval-redisplay)      (edebug-eval-redisplay)
3993      (goto-char starting-point)))      (goto-char starting-point)))
# Line 4013  May only be called from within edebug-re Line 4013  May only be called from within edebug-re
4013  (if edebug-eval-mode-map  (if edebug-eval-mode-map
4014      nil      nil
4015    (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))    (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
4016      
4017    (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)    (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
4018    (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)
4019    (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 4052  Global commands prefixed by global-edebu Line 4052  Global commands prefixed by global-edebu
4052  ;; edebug is not dependent on this, yet.  ;; edebug is not dependent on this, yet.
4053    
4054  (defun edebug (&optional edebug-arg-mode &rest debugger-args)  (defun edebug (&optional edebug-arg-mode &rest debugger-args)
4055    "Replacement for debug.      "Replacement for debug.
4056  If we are running an edebugged function,  If we are running an edebugged function,
4057  show where we last were.  Otherwise call debug normally."  show where we last were.  Otherwise call debug normally."
4058  ;;  (message "entered: %s  depth: %s  edebug-recursion-depth: %s"  ;;  (message "entered: %s  depth: %s  edebug-recursion-depth: %s"
# Line 4070  show where we last were.  Otherwise call Line 4070  show where we last were.  Otherwise call
4070              (edebug-break (null edebug-arg-mode)) ;; if called explicitly              (edebug-break (null edebug-arg-mode)) ;; if called explicitly
4071              )              )
4072          (edebug-display)          (edebug-display)
4073          (if (eq edebug-arg-mode 'error)          (if (eq edebug-arg-mode 'error)
4074              nil              nil
4075            edebug-value))            edebug-value))
4076    
# Line 4096  show where we last were.  Otherwise call Line 4096  show where we last were.  Otherwise call
4096            last-ok-point)            last-ok-point)
4097        (backtrace)        (backtrace)
4098    
4099        ;; Clean up the backtrace.          ;; Clean up the backtrace.
4100        ;; Not quite right for current edebug scheme.        ;; Not quite right for current edebug scheme.
4101        (set-buffer edebug-backtrace-buffer)        (set-buffer edebug-backtrace-buffer)
4102        (setq truncate-lines t)        (setq truncate-lines t)
# Line 4107  show where we last were.  Otherwise call Line 4107  show where we last were.  Otherwise call
4107        ;; Delete interspersed edebug internals.        ;; Delete interspersed edebug internals.
4108        (while (re-search-forward "^  \(?edebug" nil t)        (while (re-search-forward "^  \(?edebug" nil t)
4109          (beginning-of-line)          (beginning-of-line)
4110          (cond          (cond
4111           ((looking-at "^  \(edebug-after")           ((looking-at "^  \(edebug-after")
4112            ;; Previous lines may contain code, so just delete this line            ;; Previous lines may contain code, so just delete this line
4113            (setq last-ok-point (point))            (setq last-ok-point (point))
# Line 4201  reinstrument it." Line 4201  reinstrument it."
4201                last-index i)                last-index i)
4202    
4203          ;; Find all indexes on same line.          ;; Find all indexes on same line.
4204          (while (and (<= 0 (setq i (1- i)))          (while (and (<= 0 (setq i (1- i)))
4205                      (<= start-of-line (aref edebug-points i))))                      (<= start-of-line (aref edebug-points i))))
4206          ;; Insert all the indices for this line.          ;; Insert all the indices for this line.
4207          (forward-line 1)          (forward-line 1)
# Line 4217  reinstrument it." Line 4217  reinstrument it."
4217                         (goto-char (+ (aref edebug-points i) def-mark))                         (goto-char (+ (aref edebug-points i) def-mark))
4218                         (- (current-column)                         (- (current-column)
4219                            (if (= ?\( (following-char)) 0 1)))))                            (if (= ?\( (following-char)) 0 1)))))
4220              (insert (make-string              (insert (make-string
4221                       (max 0 (- col (- (point) start-of-count-line))) ?\ )                       (max 0 (- col (- (point) start-of-count-line))) ?\ )
4222                      (if (and (< 0 count)                      (if (and (< 0 count)
4223                               (not (memq coverage                               (not (memq coverage
4224                                          '(unknown ok-coverage))))                                          '(unknown ok-coverage))))
4225                          "=" "")                          "=" "")
4226                      (if (= count last-count) "" (int-to-string count))                      (if (= count last-count) "" (int-to-string count))
# Line 4307  It is removed when you hit any char." Line 4307  It is removed when you hit any char."
4307        :style toggle :selected edebug-test-coverage]        :style toggle :selected edebug-test-coverage]
4308       ["Save Windows" edebug-toggle-save-windows       ["Save Windows" edebug-toggle-save-windows
4309        :style toggle :selected edebug-save-windows]        :style toggle :selected edebug-save-windows]
4310       ["Save Point"       ["Save Point"
4311        (edebug-toggle 'edebug-save-displayed-buffer-points)        (edebug-toggle 'edebug-save-displayed-buffer-points)
4312        :style toggle :selected edebug-save-displayed-buffer-points]        :style toggle :selected edebug-save-displayed-buffer-points]
4313       ))       ))
# Line 4339  It is removed when you hit any char." Line 4339  It is removed when you hit any char."
4339  The condition is evaluated in the outside context.  The condition is evaluated in the outside context.
4340  With prefix argument, make it a temporary breakpoint."  With prefix argument, make it a temporary breakpoint."
4341      ;; (interactive "P\nxCondition: ")      ;; (interactive "P\nxCondition: ")
4342      (interactive      (interactive
4343       (list       (list
4344        current-prefix-arg        current-prefix-arg
4345        ;; Read condition as follows; getting previous condition is cumbersome:        ;; Read condition as follows; getting previous condition is cumbersome:
# Line 4357  With prefix argument, make it a temporar Line 4357  With prefix argument, make it a temporar
4357                          (cons edebug-break-condition read-expression-history)                          (cons edebug-break-condition read-expression-history)
4358                        read-expression-history)))                        read-expression-history)))
4359                (prog1                (prog1
4360                    (read-from-minibuffer                    (read-from-minibuffer
4361                     "Condition: " nil read-expression-map t                     "Condition: " nil read-expression-map t
4362                     'edebug-expression-history)                     'edebug-expression-history)
4363                  (setq read-expression-history edebug-expression-history)                  (setq read-expression-history edebug-expression-history)
# Line 4365  With prefix argument, make it a temporar Line 4365  With prefix argument, make it a temporar
4365      (edebug-modify-breakpoint t condition arg))      (edebug-modify-breakpoint t condition arg))
4366    
4367    (defun edebug-eval-expression (edebug-expr)    (defun edebug-eval-expression (edebug-expr)
4368      "Evaluate an expression in the outside environment.        "Evaluate an expression in the outside environment.
4369  If interactive, prompt for the expression.  If interactive, prompt for the expression.
4370  Print result in minibuffer."  Print result in minibuffer."
4371      (interactive (list (read-from-minibuffer      (interactive (list (read-from-minibuffer
4372                          "Eval: " nil read-expression-map t                          "Eval: " nil read-expression-map t
4373                          'read-expression-history)))                          'read-expression-history)))
4374      (princ      (princ
# Line 4386  Print result in minibuffer." Line 4386  Print result in minibuffer."
4386    
4387    ;; We need to bind zmacs-regions to nil around all calls to `mark' and    ;; We need to bind zmacs-regions to nil around all calls to `mark' and
4388    ;; `mark-marker' but don't bind it to nil before entering a recursive edit,    ;; `mark-marker' but don't bind it to nil before entering a recursive edit,
4389    ;; that is, don't interfere with the binding the user might see while    ;; that is, don't interfere with the binding the user might see while
4390    ;; executing a command.    ;; executing a command.
4391    
4392    (defvar zmacs-regions)    (defvar zmacs-regions)
4393      
4394    (defun edebug-mark ()    (defun edebug-mark ()
4395      (let ((zmacs-regions nil))      (let ((zmacs-regions nil))
4396        (mark)))        (mark)))
# Line 4408  Print result in minibuffer." Line 4408  Print result in minibuffer."
4408    )    )
4409    
4410  (defun edebug-emacs-version-specific ()  (defun edebug-emacs-version-specific ()
4411    (cond    (cond
4412     ((string-match "Lucid" emacs-version);; Lucid Emacs     ((string-match "Lucid" emacs-version);; Lucid Emacs
4413      (edebug-lemacs-specific))      (edebug-lemacs-specific))
4414    
# Line 4427  Print result in minibuffer." Line 4427  Print result in minibuffer."
4427  ;; Disabled before edebug-recursive-edit.  ;; Disabled before edebug-recursive-edit.
4428  (eval-when-compile  (eval-when-compile
4429    (if edebug-unread-command-char-warning    (if edebug-unread-command-char-warning
4430        (put 'unread-command-char 'byte-obsolete-variable        (put 'unread-command-char 'byte-obsolete-variable
4431             edebug-unread-command-char-warning)))             edebug-unread-command-char-warning)))
4432    
4433  (eval-when-compile  (eval-when-compile
# Line 4438  Print result in minibuffer." Line 4438  Print result in minibuffer."
4438    
4439    (defun byte-compile-resolve-functions (funcs)    (defun byte-compile-resolve-functions (funcs)
4440      "Say it is OK for the named functions to be unresolved."      "Say it is OK for the named functions to be unresolved."
4441      (mapcar      (mapcar
4442       (function       (function
4443        (lambda (func)        (lambda (func)
4444          (setq byte-compile-unresolved-functions          (setq byte-compile-unresolved-functions
4445                (delq (assq func byte-compile-unresolved-functions)                (delq (assq func byte-compile-unresolved-functions)
4446                      byte-compile-unresolved-functions))))                      byte-compile-unresolved-functions))))
4447       funcs)       funcs)
4448      nil)      nil)
4449      
4450    '(defun byte-compile-resolve-free-references (vars)    '(defun byte-compile-resolve-free-references (vars)
4451       "Say it is OK for the named variables to be referenced."       "Say it is OK for the named variables to be referenced."
4452       (mapcar       (mapcar
4453        (function        (function
4454         (lambda (var)         (lambda (var)
4455           (setq byte-compile-free-references           (setq byte-compile-free-references
4456                 (delq var byte-compile-free-references))))                 (delq var byte-compile-free-references))))
# Line 4459  Print result in minibuffer." Line 4459  Print result in minibuffer."
4459    
4460    '(defun byte-compile-resolve-free-assignments (vars)    '(defun byte-compile-resolve-free-assignments (vars)
4461       "Say it is OK for the named variables to be assigned."       "Say it is OK for the named variables to be assigned."
4462       (mapcar       (mapcar
4463        (function        (function
4464         (lambda (var)         (lambda (var)
4465           (setq byte-compile-free-assignments           (setq byte-compile-free-assignments
4466                 (delq var byte-compile-free-assignments))))                 (delq var byte-compile-free-assignments))))
4467        vars)        vars)
4468       nil)       nil)
4469    
4470    (byte-compile-resolve-functions    (byte-compile-resolve-functions
4471     '(reporter-submit-bug-report     '(reporter-submit-bug-report
4472       edebug-gensym ;; also in cl.el       edebug-gensym ;; also in cl.el
4473       ;; Interfaces to standard functions.       ;; Interfaces to standard functions.
4474       edebug-original-eval-defun       edebug-original-eval-defun
4475       edebug-original-read       edebug-original-read
4476       edebug-get-buffer-window       edebug-get-buffer-window
4477       edebug-mark       edebug-mark
4478       edebug-mark-marker       edebug-mark-marker
4479       edebug-input-pending-p       edebug-input-pending-p
4480       edebug-sit-for       edebug-sit-for
4481       edebug-prin1-to-string       edebug-prin1-to-string
4482       edebug-format       edebug-format
4483       ;; lemacs       ;; lemacs
4484       zmacs-deactivate-region       zmacs-deactivate-region
# Line 4508  Print result in minibuffer." Line 4508  Print result in minibuffer."
4508    (add-hook 'cl-load-hook    (add-hook 'cl-load-hook
4509              (function (lambda () (require 'cl-specs)))))              (function (lambda () (require 'cl-specs)))))
4510    
4511  ;;; 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
4512  (if (featurep 'cl-read)  (if (featurep 'cl-read)
4513      (add-hook 'edebug-setup-hook      (add-hook 'edebug-setup-hook
4514                (function (lambda () (require 'edebug-cl-read))))                (function (lambda () (require 'edebug-cl-read))))

Legend:
Removed from v.3.49.4.1  
changed lines
  Added in v.3.49.4.2

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