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