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'." |
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")) |
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)) |
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) |
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 |
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) |
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 |
|
|
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 |
|
|
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 |
|
|
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) |
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))) |
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 |
|
|
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 |
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) |
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))) |
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 |
|
|
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))) |
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) |
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)))))) |
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 |
|
|
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)) |
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. |
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. |
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 |
|
|
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 |
|
|
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)) |
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 |
|
|
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)))) |
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 |
|
|
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. |
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))) |
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 |
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) |
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 |
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 |
|
|
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 |
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) ',)) |
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 |
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 |
|
|
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 |
|
|
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)) |
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 |
|
|
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) |
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))) |
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))) |
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") |
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 |
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 |
) |
) |
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 |
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?? |
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. |
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)) |
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)) |
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 |
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) |
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 |
|
|
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)) |
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) |
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 |
|
|
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))) |
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 |
|
|
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. |
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) |
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 |
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")) |
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 |
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. |
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. |
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 |
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) |
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) |
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 |
|
|
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?? |
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 |
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 |
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 |
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 |
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) |
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) |
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 |
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))) |
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 " "") |
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))) |
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 |
)))) |
)))) |
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: |
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) |
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 |
|
|
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 |
|
|
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." |
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))) |
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? |
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)) |
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 |
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 |
|
|
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))) |
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) |
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 () |
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: ") |
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") |
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 |
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) |
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?? |
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 |
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 |
)) |
)) |
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*. |
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) |
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") |
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))) |
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) |
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" |
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 |
|
|
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) |
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)) |
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) |
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)) |
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 |
)) |
)) |
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: |
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) |
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 |
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))) |
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 |
|
|
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 |
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)))) |
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 |
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)))) |