diff options
| -rw-r--r-- | lisp/ChangeLog | 24 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 388 |
2 files changed, 212 insertions, 200 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ecb110bc30e..f0bbd7558bc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,27 @@ | |||
| 1 | 2012-09-13 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/edebug.el: Use lexical-binding. | ||
| 4 | Remove the "edebug-" prefix from non-dynamically-scoped variables. | ||
| 5 | Mark unused args with underscore. | ||
| 6 | (edebug-save-restriction, edebug-outside-excursion): Use `declare'. | ||
| 7 | (edebug-form-data): Use defvar-local. | ||
| 8 | (edebug-make-before-and-after-form, edebug-make-after-form): | ||
| 9 | Use backquote. | ||
| 10 | (edebug-args, edebug-value, edebug-after-index, edebug-arg-mode): | ||
| 11 | Not dynamically scoped any more. | ||
| 12 | (edebug--enter-trace): Add arguments `function' and `args'. | ||
| 13 | Rename from edebug-enter-trace. | ||
| 14 | (edebug-enter): Call it accordingly. Bind edebug-function explicitly. | ||
| 15 | (edebug--update-coverage): Add `after-index' and `value' args. | ||
| 16 | Rename from edebug-update-coverage. | ||
| 17 | (edebug-slow-after): Call it accordingly. | ||
| 18 | (edebug--recursive-edit): Add arg `arg-mode'. Rename from | ||
| 19 | edebug-recursive-edit. | ||
| 20 | (edebug--display): Call it accordingly. Add args `value', | ||
| 21 | `offset-index', and `arg-mode'. Rename from edebug-display. | ||
| 22 | (edebug-debugger, edebug): Call it accordingly. | ||
| 23 | (edebug-eval-display-list): Use dolist. | ||
| 24 | |||
| 1 | 2012-09-12 Juri Linkov <juri@jurta.org> | 25 | 2012-09-12 Juri Linkov <juri@jurta.org> |
| 2 | 26 | ||
| 3 | * info.el (Info-search): Don't check for isearch-mode and | 27 | * info.el (Info-search): Don't check for isearch-mode and |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f147fba167d..42260d12a82 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; edebug.el --- a source-level debugger for Emacs Lisp | 1 | ;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -237,7 +237,7 @@ If the result is non-nil, then break. Errors are ignored." | |||
| 237 | 237 | ||
| 238 | (defun get-edebug-spec (symbol) | 238 | (defun get-edebug-spec (symbol) |
| 239 | ;; Get the spec of symbol resolving all indirection. | 239 | ;; Get the spec of symbol resolving all indirection. |
| 240 | (let ((edebug-form-spec nil) | 240 | (let ((spec nil) |
| 241 | (indirect symbol)) | 241 | (indirect symbol)) |
| 242 | (while | 242 | (while |
| 243 | (progn | 243 | (progn |
| @@ -245,9 +245,8 @@ If the result is non-nil, then break. Errors are ignored." | |||
| 245 | (setq indirect | 245 | (setq indirect |
| 246 | (function-get indirect 'edebug-form-spec 'macro)))) | 246 | (function-get indirect 'edebug-form-spec 'macro)))) |
| 247 | ;; (edebug-trace "indirection: %s" edebug-form-spec) | 247 | ;; (edebug-trace "indirection: %s" edebug-form-spec) |
| 248 | (setq edebug-form-spec indirect)) | 248 | (setq spec indirect)) |
| 249 | edebug-form-spec | 249 | spec)) |
| 250 | )) | ||
| 251 | 250 | ||
| 252 | ;;;###autoload | 251 | ;;;###autoload |
| 253 | (defun edebug-basic-spec (spec) | 252 | (defun edebug-basic-spec (spec) |
| @@ -337,9 +336,7 @@ A lambda list keyword is a symbol that starts with `&'." | |||
| 337 | (lambda (e1 e2) | 336 | (lambda (e1 e2) |
| 338 | (funcall function (car e1) (car e2)))))) | 337 | (funcall function (car e1) (car e2)))))) |
| 339 | 338 | ||
| 340 | ;;(def-edebug-spec edebug-save-restriction t) | 339 | ;; Not used. |
| 341 | |||
| 342 | ;; Not used. If it is used, def-edebug-spec must be defined before use. | ||
| 343 | '(defmacro edebug-save-restriction (&rest body) | 340 | '(defmacro edebug-save-restriction (&rest body) |
| 344 | "Evaluate BODY while saving the current buffers restriction. | 341 | "Evaluate BODY while saving the current buffers restriction. |
| 345 | BODY may change buffer outside of current restriction, unlike | 342 | BODY may change buffer outside of current restriction, unlike |
| @@ -347,6 +344,7 @@ save-restriction. BODY may change the current buffer, | |||
| 347 | and the restriction will be restored to the original buffer, | 344 | and the restriction will be restored to the original buffer, |
| 348 | and the current buffer remains current. | 345 | and the current buffer remains current. |
| 349 | Return the result of the last expression in BODY." | 346 | Return the result of the last expression in BODY." |
| 347 | (declare (debug t)) | ||
| 350 | `(let ((edebug:s-r-beg (point-min-marker)) | 348 | `(let ((edebug:s-r-beg (point-min-marker)) |
| 351 | (edebug:s-r-end (point-max-marker))) | 349 | (edebug:s-r-end (point-max-marker))) |
| 352 | (unwind-protect | 350 | (unwind-protect |
| @@ -621,19 +619,19 @@ already is one.)" | |||
| 621 | ;; The internal data that is needed for edebugging is kept in the | 619 | ;; The internal data that is needed for edebugging is kept in the |
| 622 | ;; buffer-local variable `edebug-form-data'. | 620 | ;; buffer-local variable `edebug-form-data'. |
| 623 | 621 | ||
| 624 | (make-variable-buffer-local 'edebug-form-data) | 622 | (defvar-local edebug-form-data nil |
| 623 | "A list of entries associating symbols with buffer regions. | ||
| 624 | This is an automatic buffer local variable. Each entry looks like: | ||
| 625 | \(SYMBOL BEGIN-MARKER END-MARKER). The markers | ||
| 626 | are at the beginning and end of an entry level form and SYMBOL is | ||
| 627 | a symbol that holds all edebug related information for the form on its | ||
| 628 | property list. | ||
| 625 | 629 | ||
| 626 | (defvar edebug-form-data nil) | 630 | In the future (haha!), the symbol will be irrelevant and edebug data will |
| 627 | ;; A list of entries associating symbols with buffer regions. | 631 | be stored in the definitions themselves rather than in the property |
| 628 | ;; This is an automatic buffer local variable. Each entry looks like: | 632 | list of a symbol.") |
| 629 | ;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers | ||
| 630 | ;; are at the beginning and end of an entry level form and @var{symbol} is | ||
| 631 | ;; a symbol that holds all edebug related information for the form on its | ||
| 632 | ;; property list. | ||
| 633 | 633 | ||
| 634 | ;; In the future, the symbol will be irrelevant and edebug data will | 634 | ;; FIXME: Use cl-defstruct. |
| 635 | ;; be stored in the definitions themselves rather than in the property | ||
| 636 | ;; list of a symbol. | ||
| 637 | 635 | ||
| 638 | (defun edebug-make-form-data-entry (symbol begin end) | 636 | (defun edebug-make-form-data-entry (symbol begin end) |
| 639 | (list symbol begin end)) | 637 | (list symbol begin end)) |
| @@ -648,7 +646,7 @@ already is one.)" | |||
| 648 | (nth 2 entry)) | 646 | (nth 2 entry)) |
| 649 | 647 | ||
| 650 | (defsubst edebug-set-form-data-entry (entry name begin end) | 648 | (defsubst edebug-set-form-data-entry (entry name begin end) |
| 651 | (setcar entry name);; in case name is changed | 649 | (setcar entry name) ;; In case name is changed. |
| 652 | (set-marker (nth 1 entry) begin) | 650 | (set-marker (nth 1 entry) begin) |
| 653 | (set-marker (nth 2 entry) end)) | 651 | (set-marker (nth 2 entry) end)) |
| 654 | 652 | ||
| @@ -1081,7 +1079,8 @@ already is one.)" | |||
| 1081 | ;; If it gets an error, make it nil. | 1079 | ;; If it gets an error, make it nil. |
| 1082 | (let ((temp-hook edebug-setup-hook)) | 1080 | (let ((temp-hook edebug-setup-hook)) |
| 1083 | (setq edebug-setup-hook nil) | 1081 | (setq edebug-setup-hook nil) |
| 1084 | (run-hooks 'temp-hook)) | 1082 | (if (functionp temp-hook) (funcall temp-hook) |
| 1083 | (mapc #'funcall temp-hook))) | ||
| 1085 | 1084 | ||
| 1086 | (let (result | 1085 | (let (result |
| 1087 | edebug-top-window-data | 1086 | edebug-top-window-data |
| @@ -1218,8 +1217,8 @@ already is one.)" | |||
| 1218 | (defvar edebug-offset-list) ; the list of offset positions. | 1217 | (defvar edebug-offset-list) ; the list of offset positions. |
| 1219 | 1218 | ||
| 1220 | (defun edebug-inc-offset (offset) | 1219 | (defun edebug-inc-offset (offset) |
| 1221 | ;; modifies edebug-offset-index and edebug-offset-list | 1220 | ;; Modifies edebug-offset-index and edebug-offset-list |
| 1222 | ;; accesses edebug-func-marc and buffer point | 1221 | ;; accesses edebug-func-marc and buffer point. |
| 1223 | (prog1 | 1222 | (prog1 |
| 1224 | edebug-offset-index | 1223 | edebug-offset-index |
| 1225 | (setq edebug-offset-list (cons (- offset edebug-form-begin-marker) | 1224 | (setq edebug-offset-list (cons (- offset edebug-form-begin-marker) |
| @@ -1232,13 +1231,11 @@ already is one.)" | |||
| 1232 | ;; given FORM. Looks like: | 1231 | ;; given FORM. Looks like: |
| 1233 | ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM) | 1232 | ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM) |
| 1234 | ;; Also increment the offset index for subsequent use. | 1233 | ;; Also increment the offset index for subsequent use. |
| 1235 | (list 'edebug-after | 1234 | `(edebug-after (edebug-before ,before-index) ,after-index ,form)) |
| 1236 | (list 'edebug-before before-index) | ||
| 1237 | after-index form)) | ||
| 1238 | 1235 | ||
| 1239 | (defun edebug-make-after-form (form after-index) | 1236 | (defun edebug-make-after-form (form after-index) |
| 1240 | ;; Like edebug-make-before-and-after-form, but only after. | 1237 | ;; Like edebug-make-before-and-after-form, but only after. |
| 1241 | (list 'edebug-after 0 after-index form)) | 1238 | `(edebug-after 0 ,after-index ,form)) |
| 1242 | 1239 | ||
| 1243 | 1240 | ||
| 1244 | (defun edebug-unwrap (sexp) | 1241 | (defun edebug-unwrap (sexp) |
| @@ -1514,18 +1511,18 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1514 | ;; Otherwise it signals an error. The place of the error is found | 1511 | ;; Otherwise it signals an error. The place of the error is found |
| 1515 | ;; with the two before- and after-offset functions. | 1512 | ;; with the two before- and after-offset functions. |
| 1516 | 1513 | ||
| 1517 | (defun edebug-no-match (cursor &rest edebug-args) | 1514 | (defun edebug-no-match (cursor &rest args) |
| 1518 | ;; Throw a no-match, or signal an error immediately if gate is active. | 1515 | ;; Throw a no-match, or signal an error immediately if gate is active. |
| 1519 | ;; Remember this point in case we need to report this error. | 1516 | ;; Remember this point in case we need to report this error. |
| 1520 | (setq edebug-error-point (or edebug-error-point | 1517 | (setq edebug-error-point (or edebug-error-point |
| 1521 | (edebug-before-offset cursor)) | 1518 | (edebug-before-offset cursor)) |
| 1522 | edebug-best-error (or edebug-best-error edebug-args)) | 1519 | edebug-best-error (or edebug-best-error args)) |
| 1523 | (if (and edebug-gate (not edebug-&optional)) | 1520 | (if (and edebug-gate (not edebug-&optional)) |
| 1524 | (progn | 1521 | (progn |
| 1525 | (if edebug-error-point | 1522 | (if edebug-error-point |
| 1526 | (goto-char edebug-error-point)) | 1523 | (goto-char edebug-error-point)) |
| 1527 | (apply 'edebug-syntax-error edebug-args)) | 1524 | (apply 'edebug-syntax-error args)) |
| 1528 | (funcall 'throw 'no-match edebug-args))) | 1525 | (funcall 'throw 'no-match args))) |
| 1529 | 1526 | ||
| 1530 | 1527 | ||
| 1531 | (defun edebug-match (cursor specs) | 1528 | (defun edebug-match (cursor specs) |
| @@ -1752,7 +1749,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1752 | specs)))) | 1749 | specs)))) |
| 1753 | 1750 | ||
| 1754 | 1751 | ||
| 1755 | (defun edebug-match-gate (cursor) | 1752 | (defun edebug-match-gate (_cursor) |
| 1756 | ;; Simply set the gate to prevent backtracking at this level. | 1753 | ;; Simply set the gate to prevent backtracking at this level. |
| 1757 | (setq edebug-gate t) | 1754 | (setq edebug-gate t) |
| 1758 | nil) | 1755 | nil) |
| @@ -1841,7 +1838,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1841 | nil)) | 1838 | nil)) |
| 1842 | 1839 | ||
| 1843 | 1840 | ||
| 1844 | (defun edebug-match-function (cursor) | 1841 | (defun edebug-match-function (_cursor) |
| 1845 | (error "Use function-form instead of function in edebug spec")) | 1842 | (error "Use function-form instead of function in edebug spec")) |
| 1846 | 1843 | ||
| 1847 | (defun edebug-match-&define (cursor specs) | 1844 | (defun edebug-match-&define (cursor specs) |
| @@ -1898,7 +1895,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1898 | (edebug-move-cursor cursor) | 1895 | (edebug-move-cursor cursor) |
| 1899 | (list name))) | 1896 | (list name))) |
| 1900 | 1897 | ||
| 1901 | (defun edebug-match-colon-name (cursor spec) | 1898 | (defun edebug-match-colon-name (_cursor spec) |
| 1902 | ;; Set the edebug-def-name to the spec. | 1899 | ;; Set the edebug-def-name to the spec. |
| 1903 | (setq edebug-def-name | 1900 | (setq edebug-def-name |
| 1904 | (if edebug-def-name | 1901 | (if edebug-def-name |
| @@ -1983,6 +1980,8 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1983 | def-body)) | 1980 | def-body)) |
| 1984 | ;; FIXME? Isn't this missing the doc-string? Cf defun. | 1981 | ;; FIXME? Isn't this missing the doc-string? Cf defun. |
| 1985 | (def-edebug-spec defmacro | 1982 | (def-edebug-spec defmacro |
| 1983 | ;; FIXME: Improve `declare' so we can Edebug gv-expander and | ||
| 1984 | ;; gv-setter declarations. | ||
| 1986 | (&define name lambda-list [&optional ("declare" &rest sexp)] def-body)) | 1985 | (&define name lambda-list [&optional ("declare" &rest sexp)] def-body)) |
| 1987 | 1986 | ||
| 1988 | (def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list. | 1987 | (def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list. |
| @@ -2162,10 +2161,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 2162 | 2161 | ||
| 2163 | ;; Dynamically bound variables, declared globally but left unbound. | 2162 | ;; Dynamically bound variables, declared globally but left unbound. |
| 2164 | (defvar edebug-function) ; the function being executed. change name!! | 2163 | (defvar edebug-function) ; the function being executed. change name!! |
| 2165 | (defvar edebug-args) ; the arguments of the function | ||
| 2166 | (defvar edebug-data) ; the edebug data for the function | 2164 | (defvar edebug-data) ; the edebug data for the function |
| 2167 | (defvar edebug-value) ; the result of the expression | ||
| 2168 | (defvar edebug-after-index) | ||
| 2169 | (defvar edebug-def-mark) ; the mark for the definition | 2165 | (defvar edebug-def-mark) ; the mark for the definition |
| 2170 | (defvar edebug-freq-count) ; the count of expression visits. | 2166 | (defvar edebug-freq-count) ; the count of expression visits. |
| 2171 | (defvar edebug-coverage) ; the coverage results of each expression of function. | 2167 | (defvar edebug-coverage) ; the coverage results of each expression of function. |
| @@ -2191,7 +2187,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 2191 | 2187 | ||
| 2192 | ;;; Handling signals | 2188 | ;;; Handling signals |
| 2193 | 2189 | ||
| 2194 | (defun edebug-signal (edebug-signal-name edebug-signal-data) | 2190 | (defun edebug-signal (signal-name signal-data) |
| 2195 | "Signal an error. Args are SIGNAL-NAME, and associated DATA. | 2191 | "Signal an error. Args are SIGNAL-NAME, and associated DATA. |
| 2196 | A signal name is a symbol with an `error-conditions' property | 2192 | A signal name is a symbol with an `error-conditions' property |
| 2197 | that is a list of condition names. | 2193 | that is a list of condition names. |
| @@ -2205,19 +2201,18 @@ See `condition-case'. | |||
| 2205 | This is the Edebug replacement for the standard `signal'. It should | 2201 | This is the Edebug replacement for the standard `signal'. It should |
| 2206 | only be active while Edebug is. It checks `debug-on-error' to see | 2202 | only be active while Edebug is. It checks `debug-on-error' to see |
| 2207 | whether it should call the debugger. When execution is resumed, the | 2203 | whether it should call the debugger. When execution is resumed, the |
| 2208 | error is signaled again. | 2204 | error is signaled again." |
| 2209 | \n(fn SIGNAL-NAME DATA)" | 2205 | (if (and (listp debug-on-error) (memq signal-name debug-on-error)) |
| 2210 | (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error)) | 2206 | (edebug 'error (cons signal-name signal-data))) |
| 2211 | (edebug 'error (cons edebug-signal-name edebug-signal-data))) | ||
| 2212 | ;; If we reach here without another non-local exit, then send signal again. | 2207 | ;; If we reach here without another non-local exit, then send signal again. |
| 2213 | ;; i.e. the signal is not continuable, yet. | 2208 | ;; i.e. the signal is not continuable, yet. |
| 2214 | ;; Avoid infinite recursion. | 2209 | ;; Avoid infinite recursion. |
| 2215 | (let ((signal-hook-function nil)) | 2210 | (let ((signal-hook-function nil)) |
| 2216 | (signal edebug-signal-name edebug-signal-data))) | 2211 | (signal signal-name signal-data))) |
| 2217 | 2212 | ||
| 2218 | ;;; Entering Edebug | 2213 | ;;; Entering Edebug |
| 2219 | 2214 | ||
| 2220 | (defun edebug-enter (edebug-function edebug-args edebug-body) | 2215 | (defun edebug-enter (function args body) |
| 2221 | ;; Entering FUNC. The arguments are ARGS, and the body is BODY. | 2216 | ;; Entering FUNC. The arguments are ARGS, and the body is BODY. |
| 2222 | ;; Setup edebug variables and evaluate BODY. This function is called | 2217 | ;; Setup edebug variables and evaluate BODY. This function is called |
| 2223 | ;; when a function evaluated with edebug-eval-top-level-form is entered. | 2218 | ;; when a function evaluated with edebug-eval-top-level-form is entered. |
| @@ -2226,50 +2221,51 @@ error is signaled again. | |||
| 2226 | ;; Is this the first time we are entering edebug since | 2221 | ;; Is this the first time we are entering edebug since |
| 2227 | ;; lower-level recursive-edit command? | 2222 | ;; lower-level recursive-edit command? |
| 2228 | ;; More precisely, this tests whether Edebug is currently active. | 2223 | ;; More precisely, this tests whether Edebug is currently active. |
| 2229 | (if (not edebug-entered) | 2224 | (let ((edebug-function function)) |
| 2230 | (let ((edebug-entered t) | 2225 | (if (not edebug-entered) |
| 2231 | ;; Binding max-lisp-eval-depth here is OK, | 2226 | (let ((edebug-entered t) |
| 2232 | ;; but not inside an unwind-protect. | 2227 | ;; Binding max-lisp-eval-depth here is OK, |
| 2233 | ;; Doing it here also keeps it from growing too large. | 2228 | ;; but not inside an unwind-protect. |
| 2234 | (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much?? | 2229 | ;; Doing it here also keeps it from growing too large. |
| 2235 | (max-specpdl-size (+ 200 max-specpdl-size)) | 2230 | (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much?? |
| 2236 | 2231 | (max-specpdl-size (+ 200 max-specpdl-size)) | |
| 2237 | (debugger edebug-debugger) ; only while edebug is active. | 2232 | |
| 2238 | (edebug-outside-debug-on-error debug-on-error) | 2233 | (debugger edebug-debugger) ; only while edebug is active. |
| 2239 | (edebug-outside-debug-on-quit debug-on-quit) | 2234 | (edebug-outside-debug-on-error debug-on-error) |
| 2240 | ;; Binding these may not be the right thing to do. | 2235 | (edebug-outside-debug-on-quit debug-on-quit) |
| 2241 | ;; We want to allow the global values to be changed. | 2236 | ;; Binding these may not be the right thing to do. |
| 2242 | (debug-on-error (or debug-on-error edebug-on-error)) | 2237 | ;; We want to allow the global values to be changed. |
| 2243 | (debug-on-quit edebug-on-quit) | 2238 | (debug-on-error (or debug-on-error edebug-on-error)) |
| 2244 | 2239 | (debug-on-quit edebug-on-quit) | |
| 2245 | ;; Lexical bindings must be uncompiled for this to work. | 2240 | |
| 2246 | (cl-lexical-debug t)) | 2241 | ;; Lexical bindings must be uncompiled for this to work. |
| 2247 | (unwind-protect | 2242 | (cl-lexical-debug t)) |
| 2248 | (let ((signal-hook-function 'edebug-signal)) | 2243 | (unwind-protect |
| 2249 | (setq edebug-execution-mode (or edebug-next-execution-mode | 2244 | (let ((signal-hook-function 'edebug-signal)) |
| 2250 | edebug-initial-mode | 2245 | (setq edebug-execution-mode (or edebug-next-execution-mode |
| 2251 | edebug-execution-mode) | 2246 | edebug-initial-mode |
| 2252 | edebug-next-execution-mode nil) | 2247 | edebug-execution-mode) |
| 2253 | (edebug-enter edebug-function edebug-args edebug-body)))) | 2248 | edebug-next-execution-mode nil) |
| 2254 | 2249 | (edebug-enter function args body)))) | |
| 2255 | (let* ((edebug-data (get edebug-function 'edebug)) | 2250 | |
| 2256 | (edebug-def-mark (car edebug-data)) ; mark at def start | 2251 | (let* ((edebug-data (get function 'edebug)) |
| 2257 | (edebug-freq-count (get edebug-function 'edebug-freq-count)) | 2252 | (edebug-def-mark (car edebug-data)) ; mark at def start |
| 2258 | (edebug-coverage (get edebug-function 'edebug-coverage)) | 2253 | (edebug-freq-count (get function 'edebug-freq-count)) |
| 2259 | (edebug-buffer (marker-buffer edebug-def-mark)) | 2254 | (edebug-coverage (get function 'edebug-coverage)) |
| 2260 | 2255 | (edebug-buffer (marker-buffer edebug-def-mark)) | |
| 2261 | (edebug-stack (cons edebug-function edebug-stack)) | 2256 | |
| 2262 | (edebug-offset-indices (cons 0 edebug-offset-indices)) | 2257 | (edebug-stack (cons function edebug-stack)) |
| 2263 | ) | 2258 | (edebug-offset-indices (cons 0 edebug-offset-indices)) |
| 2264 | (if (get edebug-function 'edebug-on-entry) | 2259 | ) |
| 2265 | (progn | 2260 | (if (get function 'edebug-on-entry) |
| 2266 | (setq edebug-execution-mode 'step) | 2261 | (progn |
| 2267 | (if (eq (get edebug-function 'edebug-on-entry) 'temp) | 2262 | (setq edebug-execution-mode 'step) |
| 2268 | (put edebug-function 'edebug-on-entry nil)))) | 2263 | (if (eq (get function 'edebug-on-entry) 'temp) |
| 2269 | (if edebug-trace | 2264 | (put function 'edebug-on-entry nil)))) |
| 2270 | (edebug-enter-trace edebug-body) | 2265 | (if edebug-trace |
| 2271 | (funcall edebug-body)) | 2266 | (edebug--enter-trace function args body) |
| 2272 | ))) | 2267 | (funcall body)) |
| 2268 | )))) | ||
| 2273 | 2269 | ||
| 2274 | (defun edebug-var-status (var) | 2270 | (defun edebug-var-status (var) |
| 2275 | "Return a cons cell describing the status of VAR's current binding. | 2271 | "Return a cons cell describing the status of VAR's current binding. |
| @@ -2296,14 +2292,14 @@ STATUS should be a list returned by `edebug-var-status'." | |||
| 2296 | (t | 2292 | (t |
| 2297 | (set var value))))) | 2293 | (set var value))))) |
| 2298 | 2294 | ||
| 2299 | (defun edebug-enter-trace (edebug-body) | 2295 | (defun edebug--enter-trace (function args body) |
| 2300 | (let ((edebug-stack-depth (1+ edebug-stack-depth)) | 2296 | (let ((edebug-stack-depth (1+ edebug-stack-depth)) |
| 2301 | edebug-result) | 2297 | edebug-result) |
| 2302 | (edebug-print-trace-before | 2298 | (edebug-print-trace-before |
| 2303 | (format "%s args: %s" edebug-function edebug-args)) | 2299 | (format "%s args: %s" function args)) |
| 2304 | (prog1 (setq edebug-result (funcall edebug-body)) | 2300 | (prog1 (setq edebug-result (funcall body)) |
| 2305 | (edebug-print-trace-after | 2301 | (edebug-print-trace-after |
| 2306 | (format "%s result: %s" edebug-function edebug-result))))) | 2302 | (format "%s result: %s" function edebug-result))))) |
| 2307 | 2303 | ||
| 2308 | (def-edebug-spec edebug-tracing (form body)) | 2304 | (def-edebug-spec edebug-tracing (form body)) |
| 2309 | 2305 | ||
| @@ -2331,49 +2327,49 @@ MSG is printed after `::::} '." | |||
| 2331 | 2327 | ||
| 2332 | 2328 | ||
| 2333 | 2329 | ||
| 2334 | (defun edebug-slow-before (edebug-before-index) | 2330 | (defun edebug-slow-before (before-index) |
| 2335 | (unless edebug-active | 2331 | (unless edebug-active |
| 2336 | ;; Debug current function given BEFORE position. | 2332 | ;; Debug current function given BEFORE position. |
| 2337 | ;; Called from functions compiled with edebug-eval-top-level-form. | 2333 | ;; Called from functions compiled with edebug-eval-top-level-form. |
| 2338 | ;; Return the before index. | 2334 | ;; Return the before index. |
| 2339 | (setcar edebug-offset-indices edebug-before-index) | 2335 | (setcar edebug-offset-indices before-index) |
| 2340 | 2336 | ||
| 2341 | ;; Increment frequency count | 2337 | ;; Increment frequency count |
| 2342 | (aset edebug-freq-count edebug-before-index | 2338 | (aset edebug-freq-count before-index |
| 2343 | (1+ (aref edebug-freq-count edebug-before-index))) | 2339 | (1+ (aref edebug-freq-count before-index))) |
| 2344 | 2340 | ||
| 2345 | (if (or (not (memq edebug-execution-mode '(Go-nonstop next))) | 2341 | (if (or (not (memq edebug-execution-mode '(Go-nonstop next))) |
| 2346 | (edebug-input-pending-p)) | 2342 | (edebug-input-pending-p)) |
| 2347 | (edebug-debugger edebug-before-index 'before nil))) | 2343 | (edebug-debugger before-index 'before nil))) |
| 2348 | edebug-before-index) | 2344 | before-index) |
| 2349 | 2345 | ||
| 2350 | (defun edebug-fast-before (edebug-before-index) | 2346 | (defun edebug-fast-before (_before-index) |
| 2351 | ;; Do nothing. | 2347 | ;; Do nothing. |
| 2352 | ) | 2348 | ) |
| 2353 | 2349 | ||
| 2354 | (defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value) | 2350 | (defun edebug-slow-after (_before-index after-index value) |
| 2355 | (if edebug-active | 2351 | (if edebug-active |
| 2356 | edebug-value | 2352 | value |
| 2357 | ;; Debug current function given AFTER position and VALUE. | 2353 | ;; Debug current function given AFTER position and VALUE. |
| 2358 | ;; Called from functions compiled with edebug-eval-top-level-form. | 2354 | ;; Called from functions compiled with edebug-eval-top-level-form. |
| 2359 | ;; Return VALUE. | 2355 | ;; Return VALUE. |
| 2360 | (setcar edebug-offset-indices edebug-after-index) | 2356 | (setcar edebug-offset-indices after-index) |
| 2361 | 2357 | ||
| 2362 | ;; Increment frequency count | 2358 | ;; Increment frequency count |
| 2363 | (aset edebug-freq-count edebug-after-index | 2359 | (aset edebug-freq-count after-index |
| 2364 | (1+ (aref edebug-freq-count edebug-after-index))) | 2360 | (1+ (aref edebug-freq-count after-index))) |
| 2365 | (if edebug-test-coverage (edebug-update-coverage)) | 2361 | (if edebug-test-coverage (edebug--update-coverage after-index value)) |
| 2366 | 2362 | ||
| 2367 | (if (and (eq edebug-execution-mode 'Go-nonstop) | 2363 | (if (and (eq edebug-execution-mode 'Go-nonstop) |
| 2368 | (not (edebug-input-pending-p))) | 2364 | (not (edebug-input-pending-p))) |
| 2369 | ;; Just return result. | 2365 | ;; Just return result. |
| 2370 | edebug-value | 2366 | value |
| 2371 | (edebug-debugger edebug-after-index 'after edebug-value) | 2367 | (edebug-debugger after-index 'after value) |
| 2372 | ))) | 2368 | ))) |
| 2373 | 2369 | ||
| 2374 | (defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value) | 2370 | (defun edebug-fast-after (_before-index _after-index value) |
| 2375 | ;; Do nothing but return the value. | 2371 | ;; Do nothing but return the value. |
| 2376 | edebug-value) | 2372 | value) |
| 2377 | 2373 | ||
| 2378 | (defun edebug-run-slow () | 2374 | (defun edebug-run-slow () |
| 2379 | (defalias 'edebug-before 'edebug-slow-before) | 2375 | (defalias 'edebug-before 'edebug-slow-before) |
| @@ -2387,19 +2383,18 @@ MSG is printed after `::::} '." | |||
| 2387 | (edebug-run-slow) | 2383 | (edebug-run-slow) |
| 2388 | 2384 | ||
| 2389 | 2385 | ||
| 2390 | (defun edebug-update-coverage () | 2386 | (defun edebug--update-coverage (after-index value) |
| 2391 | (let ((old-result (aref edebug-coverage edebug-after-index))) | 2387 | (let ((old-result (aref edebug-coverage after-index))) |
| 2392 | (cond | 2388 | (cond |
| 2393 | ((eq 'ok-coverage old-result)) | 2389 | ((eq 'ok-coverage old-result)) |
| 2394 | ((eq 'unknown old-result) | 2390 | ((eq 'unknown old-result) |
| 2395 | (aset edebug-coverage edebug-after-index edebug-value)) | 2391 | (aset edebug-coverage after-index value)) |
| 2396 | ;; Test if a different result. | 2392 | ;; Test if a different result. |
| 2397 | ((not (eq edebug-value old-result)) | 2393 | ((not (eq value old-result)) |
| 2398 | (aset edebug-coverage edebug-after-index 'ok-coverage))))) | 2394 | (aset edebug-coverage after-index 'ok-coverage))))) |
| 2399 | 2395 | ||
| 2400 | 2396 | ||
| 2401 | ;; Dynamically declared unbound variables. | 2397 | ;; Dynamically declared unbound variables. |
| 2402 | (defvar edebug-arg-mode) ; the mode, either before, after, or error | ||
| 2403 | (defvar edebug-breakpoints) | 2398 | (defvar edebug-breakpoints) |
| 2404 | (defvar edebug-break-data) ; break data for current function. | 2399 | (defvar edebug-break-data) ; break data for current function. |
| 2405 | (defvar edebug-break) ; whether a break occurred. | 2400 | (defvar edebug-break) ; whether a break occurred. |
| @@ -2410,16 +2405,16 @@ MSG is printed after `::::} '." | |||
| 2410 | (defvar edebug-global-break-result nil) | 2405 | (defvar edebug-global-break-result nil) |
| 2411 | 2406 | ||
| 2412 | 2407 | ||
| 2413 | (defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value) | 2408 | (defun edebug-debugger (offset-index arg-mode value) |
| 2414 | (if inhibit-redisplay | 2409 | (if inhibit-redisplay |
| 2415 | ;; Don't really try to enter edebug within an eval from redisplay. | 2410 | ;; Don't really try to enter edebug within an eval from redisplay. |
| 2416 | edebug-value | 2411 | value |
| 2417 | ;; Check breakpoints and pending input. | 2412 | ;; Check breakpoints and pending input. |
| 2418 | ;; If edebug display should be updated, call edebug-display. | 2413 | ;; If edebug display should be updated, call edebug--display. |
| 2419 | ;; Return edebug-value. | 2414 | ;; Return value. |
| 2420 | (let* ( ;; This needs to be here since breakpoints may be changed. | 2415 | (let* ( ;; This needs to be here since breakpoints may be changed. |
| 2421 | (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints | 2416 | (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints |
| 2422 | (edebug-break-data (assq edebug-offset-index edebug-breakpoints)) | 2417 | (edebug-break-data (assq offset-index edebug-breakpoints)) |
| 2423 | (edebug-break-condition (car (cdr edebug-break-data))) | 2418 | (edebug-break-condition (car (cdr edebug-break-data))) |
| 2424 | (edebug-global-break | 2419 | (edebug-global-break |
| 2425 | (if edebug-global-break-condition | 2420 | (if edebug-global-break-condition |
| @@ -2430,7 +2425,7 @@ MSG is printed after `::::} '." | |||
| 2430 | (error nil)))) | 2425 | (error nil)))) |
| 2431 | (edebug-break)) | 2426 | (edebug-break)) |
| 2432 | 2427 | ||
| 2433 | ;;; (edebug-trace "exp: %s" edebug-value) | 2428 | ;;(edebug-trace "exp: %s" value) |
| 2434 | ;; Test whether we should break. | 2429 | ;; Test whether we should break. |
| 2435 | (setq edebug-break | 2430 | (setq edebug-break |
| 2436 | (or edebug-global-break | 2431 | (or edebug-global-break |
| @@ -2451,10 +2446,9 @@ MSG is printed after `::::} '." | |||
| 2451 | (if (or (not (memq edebug-execution-mode '(go continue Continue-fast))) | 2446 | (if (or (not (memq edebug-execution-mode '(go continue Continue-fast))) |
| 2452 | edebug-break | 2447 | edebug-break |
| 2453 | (edebug-input-pending-p)) | 2448 | (edebug-input-pending-p)) |
| 2454 | (edebug-display)) ; <--------------- display | 2449 | (edebug--display value offset-index arg-mode)) ; <---------- display |
| 2455 | 2450 | ||
| 2456 | edebug-value | 2451 | value))) |
| 2457 | ))) | ||
| 2458 | 2452 | ||
| 2459 | 2453 | ||
| 2460 | ;; window-start now stored with each function. | 2454 | ;; window-start now stored with each function. |
| @@ -2487,7 +2481,7 @@ MSG is printed after `::::} '." | |||
| 2487 | (defalias 'edebug-mark-marker 'mark-marker) | 2481 | (defalias 'edebug-mark-marker 'mark-marker) |
| 2488 | 2482 | ||
| 2489 | 2483 | ||
| 2490 | (defun edebug-display () | 2484 | (defun edebug--display (value offset-index arg-mode) |
| 2491 | (unless (marker-position edebug-def-mark) | 2485 | (unless (marker-position edebug-def-mark) |
| 2492 | ;; The buffer holding the source has been killed. | 2486 | ;; The buffer holding the source has been killed. |
| 2493 | ;; Let's at least show a backtrace so the user can figure out | 2487 | ;; Let's at least show a backtrace so the user can figure out |
| @@ -2496,11 +2490,11 @@ MSG is printed after `::::} '." | |||
| 2496 | ;; Setup windows for edebug, determine mode, maybe enter recursive-edit. | 2490 | ;; Setup windows for edebug, determine mode, maybe enter recursive-edit. |
| 2497 | ;; Uses local variables of edebug-enter, edebug-before, edebug-after | 2491 | ;; Uses local variables of edebug-enter, edebug-before, edebug-after |
| 2498 | ;; and edebug-debugger. | 2492 | ;; and edebug-debugger. |
| 2499 | (let ((edebug-active t) ; for minor mode alist | 2493 | (let ((edebug-active t) ; For minor mode alist. |
| 2500 | (edebug-with-timeout-suspend (with-timeout-suspend)) | 2494 | (edebug-with-timeout-suspend (with-timeout-suspend)) |
| 2501 | edebug-stop ; should we enter recursive-edit | 2495 | edebug-stop ; Should we enter recursive-edit? |
| 2502 | (edebug-point (+ edebug-def-mark | 2496 | (edebug-point (+ edebug-def-mark |
| 2503 | (aref (nth 2 edebug-data) edebug-offset-index))) | 2497 | (aref (nth 2 edebug-data) offset-index))) |
| 2504 | edebug-buffer-outside-point ; current point in edebug-buffer | 2498 | edebug-buffer-outside-point ; current point in edebug-buffer |
| 2505 | ;; window displaying edebug-buffer | 2499 | ;; window displaying edebug-buffer |
| 2506 | (edebug-window-data (nth 3 edebug-data)) | 2500 | (edebug-window-data (nth 3 edebug-data)) |
| @@ -2509,12 +2503,12 @@ MSG is printed after `::::} '." | |||
| 2509 | (edebug-outside-point (point)) | 2503 | (edebug-outside-point (point)) |
| 2510 | (edebug-outside-mark (edebug-mark)) | 2504 | (edebug-outside-mark (edebug-mark)) |
| 2511 | (edebug-outside-unread-command-events unread-command-events) | 2505 | (edebug-outside-unread-command-events unread-command-events) |
| 2512 | edebug-outside-windows ; window or screen configuration | 2506 | edebug-outside-windows ; Window or screen configuration. |
| 2513 | edebug-buffer-points | 2507 | edebug-buffer-points |
| 2514 | 2508 | ||
| 2515 | edebug-eval-buffer ; declared here so we can kill it below | 2509 | edebug-eval-buffer ; Declared here so we can kill it below. |
| 2516 | (edebug-eval-result-list (and edebug-eval-list | 2510 | (eval-result-list (and edebug-eval-list |
| 2517 | (edebug-eval-result-list))) | 2511 | (edebug-eval-result-list))) |
| 2518 | edebug-trace-window | 2512 | edebug-trace-window |
| 2519 | edebug-trace-window-start | 2513 | edebug-trace-window-start |
| 2520 | 2514 | ||
| @@ -2535,9 +2529,9 @@ MSG is printed after `::::} '." | |||
| 2535 | (let ((debug-on-error nil)) | 2529 | (let ((debug-on-error nil)) |
| 2536 | (error "Buffer defining %s not found" edebug-function))) | 2530 | (error "Buffer defining %s not found" edebug-function))) |
| 2537 | 2531 | ||
| 2538 | (if (eq 'after edebug-arg-mode) | 2532 | (if (eq 'after arg-mode) |
| 2539 | ;; Compute result string now before windows are modified. | 2533 | ;; Compute result string now before windows are modified. |
| 2540 | (edebug-compute-previous-result edebug-value)) | 2534 | (edebug-compute-previous-result value)) |
| 2541 | 2535 | ||
| 2542 | (if edebug-save-windows | 2536 | (if edebug-save-windows |
| 2543 | ;; Save windows now before we modify them. | 2537 | ;; Save windows now before we modify them. |
| @@ -2561,7 +2555,7 @@ MSG is printed after `::::} '." | |||
| 2561 | ;; Now display eval list, if any. | 2555 | ;; Now display eval list, if any. |
| 2562 | ;; This is done after the pop to edebug-buffer | 2556 | ;; This is done after the pop to edebug-buffer |
| 2563 | ;; so that buffer-window correspondence is correct after quitting. | 2557 | ;; so that buffer-window correspondence is correct after quitting. |
| 2564 | (edebug-eval-display edebug-eval-result-list) | 2558 | (edebug-eval-display eval-result-list) |
| 2565 | ;; The evaluation list better not have deleted edebug-window-data. | 2559 | ;; The evaluation list better not have deleted edebug-window-data. |
| 2566 | (select-window (car edebug-window-data)) | 2560 | (select-window (car edebug-window-data)) |
| 2567 | (set-buffer edebug-buffer) | 2561 | (set-buffer edebug-buffer) |
| @@ -2569,7 +2563,7 @@ MSG is printed after `::::} '." | |||
| 2569 | (setq edebug-buffer-outside-point (point)) | 2563 | (setq edebug-buffer-outside-point (point)) |
| 2570 | (goto-char edebug-point) | 2564 | (goto-char edebug-point) |
| 2571 | 2565 | ||
| 2572 | (if (eq 'before edebug-arg-mode) | 2566 | (if (eq 'before arg-mode) |
| 2573 | ;; Check whether positions are up-to-date. | 2567 | ;; Check whether positions are up-to-date. |
| 2574 | ;; This assumes point is never before symbol. | 2568 | ;; This assumes point is never before symbol. |
| 2575 | (if (not (memq (following-char) '(?\( ?\# ?\` ))) | 2569 | (if (not (memq (following-char) '(?\( ?\# ?\` ))) |
| @@ -2593,14 +2587,14 @@ MSG is printed after `::::} '." | |||
| 2593 | (edebug-overlay-arrow) | 2587 | (edebug-overlay-arrow) |
| 2594 | 2588 | ||
| 2595 | (cond | 2589 | (cond |
| 2596 | ((eq 'error edebug-arg-mode) | 2590 | ((eq 'error arg-mode) |
| 2597 | ;; Display error message | 2591 | ;; Display error message |
| 2598 | (setq edebug-execution-mode 'step) | 2592 | (setq edebug-execution-mode 'step) |
| 2599 | (edebug-overlay-arrow) | 2593 | (edebug-overlay-arrow) |
| 2600 | (beep) | 2594 | (beep) |
| 2601 | (if (eq 'quit (car edebug-value)) | 2595 | (if (eq 'quit (car value)) |
| 2602 | (message "Quit") | 2596 | (message "Quit") |
| 2603 | (edebug-report-error edebug-value))) | 2597 | (edebug-report-error value))) |
| 2604 | (edebug-break | 2598 | (edebug-break |
| 2605 | (cond | 2599 | (cond |
| 2606 | (edebug-global-break | 2600 | (edebug-global-break |
| @@ -2618,7 +2612,7 @@ MSG is printed after `::::} '." | |||
| 2618 | (t (message ""))) | 2612 | (t (message ""))) |
| 2619 | 2613 | ||
| 2620 | (setq unread-command-events nil) | 2614 | (setq unread-command-events nil) |
| 2621 | (if (eq 'after edebug-arg-mode) | 2615 | (if (eq 'after arg-mode) |
| 2622 | (progn | 2616 | (progn |
| 2623 | ;; Display result of previous evaluation. | 2617 | ;; Display result of previous evaluation. |
| 2624 | (if (and edebug-break | 2618 | (if (and edebug-break |
| @@ -2642,11 +2636,11 @@ MSG is printed after `::::} '." | |||
| 2642 | (unwind-protect | 2636 | (unwind-protect |
| 2643 | (if (or edebug-stop | 2637 | (if (or edebug-stop |
| 2644 | (memq edebug-execution-mode '(step next)) | 2638 | (memq edebug-execution-mode '(step next)) |
| 2645 | (eq edebug-arg-mode 'error)) | 2639 | (eq arg-mode 'error)) |
| 2646 | (progn | 2640 | (progn |
| 2647 | ;; (setq edebug-execution-mode 'step) | 2641 | ;; (setq edebug-execution-mode 'step) |
| 2648 | ;; (edebug-overlay-arrow) ; This doesn't always show up. | 2642 | ;; (edebug-overlay-arrow) ; This doesn't always show up. |
| 2649 | (edebug-recursive-edit))) ; <---------- Recursive edit | 2643 | (edebug--recursive-edit arg-mode))) ; <----- Recursive edit |
| 2650 | 2644 | ||
| 2651 | ;; Reset the edebug-window-data to whatever it is now. | 2645 | ;; Reset the edebug-window-data to whatever it is now. |
| 2652 | (let ((window (if (eq (window-buffer) edebug-buffer) | 2646 | (let ((window (if (eq (window-buffer) edebug-buffer) |
| @@ -2775,7 +2769,7 @@ MSG is printed after `::::} '." | |||
| 2775 | (defvar edebug-outside-last-nonmenu-event) | 2769 | (defvar edebug-outside-last-nonmenu-event) |
| 2776 | (defvar edebug-outside-track-mouse) | 2770 | (defvar edebug-outside-track-mouse) |
| 2777 | 2771 | ||
| 2778 | (defun edebug-recursive-edit () | 2772 | (defun edebug--recursive-edit (arg-mode) |
| 2779 | ;; Start up a recursive edit inside of edebug. | 2773 | ;; Start up a recursive edit inside of edebug. |
| 2780 | ;; The current buffer is the edebug-buffer, which is put into edebug-mode. | 2774 | ;; The current buffer is the edebug-buffer, which is put into edebug-mode. |
| 2781 | ;; Assume that none of the variables below are buffer-local. | 2775 | ;; Assume that none of the variables below are buffer-local. |
| @@ -2866,7 +2860,7 @@ MSG is printed after `::::} '." | |||
| 2866 | ) | 2860 | ) |
| 2867 | 2861 | ||
| 2868 | (if (and (eq edebug-execution-mode 'go) | 2862 | (if (and (eq edebug-execution-mode 'go) |
| 2869 | (not (memq edebug-arg-mode '(after error)))) | 2863 | (not (memq arg-mode '(after error)))) |
| 2870 | (message "Break")) | 2864 | (message "Break")) |
| 2871 | 2865 | ||
| 2872 | (setq buffer-read-only t) | 2866 | (setq buffer-read-only t) |
| @@ -3082,7 +3076,7 @@ before returning. The default is one second." | |||
| 3082 | 3076 | ||
| 3083 | 3077 | ||
| 3084 | ;; Joe Wells, here is a start at your idea of adding a buffer to the internal | 3078 | ;; Joe Wells, here is a start at your idea of adding a buffer to the internal |
| 3085 | ;; display list. Still need to use this list in edebug-display. | 3079 | ;; display list. Still need to use this list in edebug--display. |
| 3086 | 3080 | ||
| 3087 | '(defvar edebug-display-buffer-list nil | 3081 | '(defvar edebug-display-buffer-list nil |
| 3088 | "List of buffers that edebug will display when it is active.") | 3082 | "List of buffers that edebug will display when it is active.") |
| @@ -3517,11 +3511,10 @@ edebug-mode." | |||
| 3517 | 3511 | ||
| 3518 | ;;; Evaluation of expressions | 3512 | ;;; Evaluation of expressions |
| 3519 | 3513 | ||
| 3520 | (def-edebug-spec edebug-outside-excursion t) | ||
| 3521 | |||
| 3522 | (defmacro edebug-outside-excursion (&rest body) | 3514 | (defmacro edebug-outside-excursion (&rest body) |
| 3523 | "Evaluate an expression list in the outside context. | 3515 | "Evaluate an expression list in the outside context. |
| 3524 | Return the result of the last expression." | 3516 | Return the result of the last expression." |
| 3517 | (declare (debug t)) | ||
| 3525 | `(save-excursion ; of current-buffer | 3518 | `(save-excursion ; of current-buffer |
| 3526 | (if edebug-save-windows | 3519 | (if edebug-save-windows |
| 3527 | (progn | 3520 | (progn |
| @@ -3555,7 +3548,7 @@ Return the result of the last expression." | |||
| 3555 | (pre-command-hook (cdr edebug-outside-pre-command-hook)) | 3548 | (pre-command-hook (cdr edebug-outside-pre-command-hook)) |
| 3556 | (post-command-hook (cdr edebug-outside-post-command-hook)) | 3549 | (post-command-hook (cdr edebug-outside-post-command-hook)) |
| 3557 | 3550 | ||
| 3558 | ;; See edebug-display | 3551 | ;; See edebug-display. |
| 3559 | (overlay-arrow-position edebug-outside-o-a-p) | 3552 | (overlay-arrow-position edebug-outside-o-a-p) |
| 3560 | (overlay-arrow-string edebug-outside-o-a-s) | 3553 | (overlay-arrow-string edebug-outside-o-a-s) |
| 3561 | (cursor-in-echo-area edebug-outside-c-i-e-a) | 3554 | (cursor-in-echo-area edebug-outside-c-i-e-a) |
| @@ -3609,18 +3602,18 @@ Return the result of the last expression." | |||
| 3609 | 3602 | ||
| 3610 | (defvar cl-debug-env) ; defined in cl; non-nil when lexical env used. | 3603 | (defvar cl-debug-env) ; defined in cl; non-nil when lexical env used. |
| 3611 | 3604 | ||
| 3612 | (defun edebug-eval (edebug-expr) | 3605 | (defun edebug-eval (expr) |
| 3613 | ;; Are there cl lexical variables active? | 3606 | ;; Are there cl lexical variables active? |
| 3614 | (eval (if (bound-and-true-p cl-debug-env) | 3607 | (eval (if (bound-and-true-p cl-debug-env) |
| 3615 | (cl-macroexpand-all edebug-expr cl-debug-env) | 3608 | (cl-macroexpand-all expr cl-debug-env) |
| 3616 | edebug-expr) | 3609 | expr) |
| 3617 | lexical-binding)) | 3610 | lexical-binding)) |
| 3618 | 3611 | ||
| 3619 | (defun edebug-safe-eval (edebug-expr) | 3612 | (defun edebug-safe-eval (expr) |
| 3620 | ;; Evaluate EXPR safely. | 3613 | ;; Evaluate EXPR safely. |
| 3621 | ;; If there is an error, a string is returned describing the error. | 3614 | ;; If there is an error, a string is returned describing the error. |
| 3622 | (condition-case edebug-err | 3615 | (condition-case edebug-err |
| 3623 | (edebug-eval edebug-expr) | 3616 | (edebug-eval expr) |
| 3624 | (error (edebug-format "%s: %s" ;; could | 3617 | (error (edebug-format "%s: %s" ;; could |
| 3625 | (get (car edebug-err) 'error-message) | 3618 | (get (car edebug-err) 'error-message) |
| 3626 | (car (cdr edebug-err)))))) | 3619 | (car (cdr edebug-err)))))) |
| @@ -3628,17 +3621,17 @@ Return the result of the last expression." | |||
| 3628 | ;;; Printing | 3621 | ;;; Printing |
| 3629 | 3622 | ||
| 3630 | 3623 | ||
| 3631 | (defun edebug-report-error (edebug-value) | 3624 | (defun edebug-report-error (value) |
| 3632 | ;; Print an error message like command level does. | 3625 | ;; Print an error message like command level does. |
| 3633 | ;; This also prints the error name if it has no error-message. | 3626 | ;; This also prints the error name if it has no error-message. |
| 3634 | (message "%s: %s" | 3627 | (message "%s: %s" |
| 3635 | (or (get (car edebug-value) 'error-message) | 3628 | (or (get (car value) 'error-message) |
| 3636 | (format "peculiar error (%s)" (car edebug-value))) | 3629 | (format "peculiar error (%s)" (car value))) |
| 3637 | (mapconcat (function (lambda (edebug-arg) | 3630 | (mapconcat (function (lambda (edebug-arg) |
| 3638 | ;; continuing after an error may | 3631 | ;; continuing after an error may |
| 3639 | ;; complain about edebug-arg. why?? | 3632 | ;; complain about edebug-arg. why?? |
| 3640 | (prin1-to-string edebug-arg))) | 3633 | (prin1-to-string edebug-arg))) |
| 3641 | (cdr edebug-value) ", "))) | 3634 | (cdr value) ", "))) |
| 3642 | 3635 | ||
| 3643 | (defvar print-readably) ; defined by lemacs | 3636 | (defvar print-readably) ; defined by lemacs |
| 3644 | ;; Alternatively, we could change the definition of | 3637 | ;; Alternatively, we could change the definition of |
| @@ -3654,14 +3647,14 @@ Return the result of the last expression." | |||
| 3654 | (edebug-prin1-to-string value) | 3647 | (edebug-prin1-to-string value) |
| 3655 | (error "#Apparently circular structure#")))) | 3648 | (error "#Apparently circular structure#")))) |
| 3656 | 3649 | ||
| 3657 | (defun edebug-compute-previous-result (edebug-previous-value) | 3650 | (defun edebug-compute-previous-result (previous-value) |
| 3658 | (if edebug-unwrap-results | 3651 | (if edebug-unwrap-results |
| 3659 | (setq edebug-previous-value | 3652 | (setq previous-value |
| 3660 | (edebug-unwrap* edebug-previous-value))) | 3653 | (edebug-unwrap* previous-value))) |
| 3661 | (setq edebug-previous-result | 3654 | (setq edebug-previous-result |
| 3662 | (concat "Result: " | 3655 | (concat "Result: " |
| 3663 | (edebug-safe-prin1-to-string edebug-previous-value) | 3656 | (edebug-safe-prin1-to-string previous-value) |
| 3664 | (eval-expression-print-format edebug-previous-value)))) | 3657 | (eval-expression-print-format previous-value)))) |
| 3665 | 3658 | ||
| 3666 | (defun edebug-previous-result () | 3659 | (defun edebug-previous-result () |
| 3667 | "Print the previous result." | 3660 | "Print the previous result." |
| @@ -3676,7 +3669,7 @@ Return the result of the last expression." | |||
| 3676 | (defalias 'edebug-format 'format) | 3669 | (defalias 'edebug-format 'format) |
| 3677 | (defalias 'edebug-message 'message) | 3670 | (defalias 'edebug-message 'message) |
| 3678 | 3671 | ||
| 3679 | (defun edebug-eval-expression (edebug-expr) | 3672 | (defun edebug-eval-expression (expr) |
| 3680 | "Evaluate an expression in the outside environment. | 3673 | "Evaluate an expression in the outside environment. |
| 3681 | If interactive, prompt for the expression. | 3674 | If interactive, prompt for the expression. |
| 3682 | Print result in minibuffer." | 3675 | Print result in minibuffer." |
| @@ -3685,7 +3678,7 @@ Print result in minibuffer." | |||
| 3685 | 'read-expression-history))) | 3678 | 'read-expression-history))) |
| 3686 | (princ | 3679 | (princ |
| 3687 | (edebug-outside-excursion | 3680 | (edebug-outside-excursion |
| 3688 | (setq values (cons (edebug-eval edebug-expr) values)) | 3681 | (setq values (cons (edebug-eval expr) values)) |
| 3689 | (concat (edebug-safe-prin1-to-string (car values)) | 3682 | (concat (edebug-safe-prin1-to-string (car values)) |
| 3690 | (eval-expression-print-format (car values)))))) | 3683 | (eval-expression-print-format (car values)))))) |
| 3691 | 3684 | ||
| @@ -3699,14 +3692,14 @@ Print value in minibuffer." | |||
| 3699 | "Evaluate sexp before point in outside environment; insert value. | 3692 | "Evaluate sexp before point in outside environment; insert value. |
| 3700 | This prints the value into current buffer." | 3693 | This prints the value into current buffer." |
| 3701 | (interactive) | 3694 | (interactive) |
| 3702 | (let* ((edebug-form (edebug-last-sexp)) | 3695 | (let* ((form (edebug-last-sexp)) |
| 3703 | (edebug-result-string | 3696 | (result-string |
| 3704 | (edebug-outside-excursion | 3697 | (edebug-outside-excursion |
| 3705 | (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form)))) | 3698 | (edebug-safe-prin1-to-string (edebug-safe-eval form)))) |
| 3706 | (standard-output (current-buffer))) | 3699 | (standard-output (current-buffer))) |
| 3707 | (princ "\n") | 3700 | (princ "\n") |
| 3708 | ;; princ the string to get rid of quotes. | 3701 | ;; princ the string to get rid of quotes. |
| 3709 | (princ edebug-result-string) | 3702 | (princ result-string) |
| 3710 | (princ "\n") | 3703 | (princ "\n") |
| 3711 | )) | 3704 | )) |
| 3712 | 3705 | ||
| @@ -3898,20 +3891,17 @@ Options: | |||
| 3898 | (edebug-trace nil)) | 3891 | (edebug-trace nil)) |
| 3899 | (mapcar 'edebug-safe-eval edebug-eval-list))) | 3892 | (mapcar 'edebug-safe-eval edebug-eval-list))) |
| 3900 | 3893 | ||
| 3901 | (defun edebug-eval-display-list (edebug-eval-result-list) | 3894 | (defun edebug-eval-display-list (eval-result-list) |
| 3902 | ;; Assumes edebug-eval-buffer exists. | 3895 | ;; Assumes edebug-eval-buffer exists. |
| 3903 | (let ((edebug-eval-list-temp edebug-eval-list) | 3896 | (let ((standard-output edebug-eval-buffer) |
| 3904 | (standard-output edebug-eval-buffer) | ||
| 3905 | (edebug-comment-line | 3897 | (edebug-comment-line |
| 3906 | (format ";%s\n" (make-string (- (window-width) 2) ?-)))) | 3898 | (format ";%s\n" (make-string (- (window-width) 2) ?-)))) |
| 3907 | (set-buffer edebug-eval-buffer) | 3899 | (set-buffer edebug-eval-buffer) |
| 3908 | (erase-buffer) | 3900 | (erase-buffer) |
| 3909 | (while edebug-eval-list-temp | 3901 | (dolist (exp edebug-eval-list) |
| 3910 | (prin1 (car edebug-eval-list-temp)) (terpri) | 3902 | (prin1 exp) (terpri) |
| 3911 | (prin1 (car edebug-eval-result-list)) (terpri) | 3903 | (prin1 (pop eval-result-list)) (terpri) |
| 3912 | (princ edebug-comment-line) | 3904 | (princ edebug-comment-line)) |
| 3913 | (setq edebug-eval-list-temp (cdr edebug-eval-list-temp)) | ||
| 3914 | (setq edebug-eval-result-list (cdr edebug-eval-result-list))) | ||
| 3915 | (edebug-pop-to-buffer edebug-eval-buffer) | 3905 | (edebug-pop-to-buffer edebug-eval-buffer) |
| 3916 | )) | 3906 | )) |
| 3917 | 3907 | ||
| @@ -3924,18 +3914,16 @@ Options: | |||
| 3924 | ;; Should generalize this to be callable outside of edebug | 3914 | ;; Should generalize this to be callable outside of edebug |
| 3925 | ;; with calls in user functions, e.g. (edebug-eval-display) | 3915 | ;; with calls in user functions, e.g. (edebug-eval-display) |
| 3926 | 3916 | ||
| 3927 | (defun edebug-eval-display (edebug-eval-result-list) | 3917 | (defun edebug-eval-display (eval-result-list) |
| 3928 | "Display expressions and evaluations in EDEBUG-EVAL-RESULT-LIST. | 3918 | "Display expressions and evaluations in EVAL-RESULT-LIST. |
| 3929 | It modifies the context by popping up the eval display." | 3919 | It modifies the context by popping up the eval display." |
| 3930 | (if edebug-eval-result-list | 3920 | (when eval-result-list |
| 3931 | (progn | 3921 | (edebug-create-eval-buffer) |
| 3932 | (edebug-create-eval-buffer) | 3922 | (edebug-eval-display-list eval-result-list))) |
| 3933 | (edebug-eval-display-list edebug-eval-result-list) | ||
| 3934 | ))) | ||
| 3935 | 3923 | ||
| 3936 | (defun edebug-eval-redisplay () | 3924 | (defun edebug-eval-redisplay () |
| 3937 | "Redisplay eval list in outside environment. | 3925 | "Redisplay eval list in outside environment. |
| 3938 | May only be called from within `edebug-recursive-edit'." | 3926 | May only be called from within `edebug--recursive-edit'." |
| 3939 | (edebug-create-eval-buffer) | 3927 | (edebug-create-eval-buffer) |
| 3940 | (edebug-outside-excursion | 3928 | (edebug-outside-excursion |
| 3941 | (edebug-eval-display-list (edebug-eval-result-list)) | 3929 | (edebug-eval-display-list (edebug-eval-result-list)) |
| @@ -3997,8 +3985,8 @@ May only be called from within `edebug-recursive-edit'." | |||
| 3997 | (define-key map "\C-c\C-u" 'edebug-update-eval-list) | 3985 | (define-key map "\C-c\C-u" 'edebug-update-eval-list) |
| 3998 | (define-key map "\C-x\C-e" 'edebug-eval-last-sexp) | 3986 | (define-key map "\C-x\C-e" 'edebug-eval-last-sexp) |
| 3999 | (define-key map "\C-j" 'edebug-eval-print-last-sexp) | 3987 | (define-key map "\C-j" 'edebug-eval-print-last-sexp) |
| 4000 | map) | 3988 | map) |
| 4001 | "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.") | 3989 | "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.") |
| 4002 | 3990 | ||
| 4003 | (put 'edebug-eval-mode 'mode-class 'special) | 3991 | (put 'edebug-eval-mode 'mode-class 'special) |
| 4004 | 3992 | ||
| @@ -4025,32 +4013,32 @@ Global commands prefixed by `global-edebug-prefix': | |||
| 4025 | ;; since they depend on the backtrace looking a certain way. But | 4013 | ;; since they depend on the backtrace looking a certain way. But |
| 4026 | ;; edebug is not dependent on this, yet. | 4014 | ;; edebug is not dependent on this, yet. |
| 4027 | 4015 | ||
| 4028 | (defun edebug (&optional edebug-arg-mode &rest debugger-args) | 4016 | (defun edebug (&optional arg-mode &rest args) |
| 4029 | "Replacement for `debug'. | 4017 | "Replacement for `debug'. |
| 4030 | If we are running an edebugged function, show where we last were. | 4018 | If we are running an edebugged function, show where we last were. |
| 4031 | Otherwise call `debug' normally." | 4019 | Otherwise call `debug' normally." |
| 4032 | ;; (message "entered: %s depth: %s edebug-recursion-depth: %s" | 4020 | ;;(message "entered: %s depth: %s edebug-recursion-depth: %s" |
| 4033 | ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1) | 4021 | ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1) |
| 4034 | (if (and edebug-entered ; anything active? | 4022 | (if (and edebug-entered ; anything active? |
| 4035 | (eq (recursion-depth) edebug-recursion-depth)) | 4023 | (eq (recursion-depth) edebug-recursion-depth)) |
| 4036 | (let (;; Where were we before the error occurred? | 4024 | (let (;; Where were we before the error occurred? |
| 4037 | (edebug-offset-index (car edebug-offset-indices)) | 4025 | (offset-index (car edebug-offset-indices)) |
| 4038 | ;; Bind variables required by edebug-display | 4026 | (value (car args)) |
| 4039 | (edebug-value (car debugger-args)) | 4027 | ;; Bind variables required by edebug--display. |
| 4040 | edebug-breakpoints | 4028 | edebug-breakpoints |
| 4041 | edebug-break-data | 4029 | edebug-break-data |
| 4042 | edebug-break-condition | 4030 | edebug-break-condition |
| 4043 | edebug-global-break | 4031 | edebug-global-break |
| 4044 | (edebug-break (null edebug-arg-mode)) ;; if called explicitly | 4032 | (edebug-break (null arg-mode)) ;; If called explicitly. |
| 4045 | ) | 4033 | ) |
| 4046 | (edebug-display) | 4034 | (edebug--display value offset-index arg-mode) |
| 4047 | (if (eq edebug-arg-mode 'error) | 4035 | (if (eq arg-mode 'error) |
| 4048 | nil | 4036 | nil |
| 4049 | edebug-value)) | 4037 | value)) |
| 4050 | 4038 | ||
| 4051 | ;; Otherwise call debug normally. | 4039 | ;; Otherwise call debug normally. |
| 4052 | ;; Still need to remove extraneous edebug calls from stack. | 4040 | ;; Still need to remove extraneous edebug calls from stack. |
| 4053 | (apply 'debug edebug-arg-mode debugger-args) | 4041 | (apply 'debug arg-mode args) |
| 4054 | )) | 4042 | )) |
| 4055 | 4043 | ||
| 4056 | 4044 | ||
| @@ -4061,7 +4049,7 @@ Otherwise call `debug' normally." | |||
| 4061 | (null (buffer-name edebug-backtrace-buffer))) | 4049 | (null (buffer-name edebug-backtrace-buffer))) |
| 4062 | (setq edebug-backtrace-buffer | 4050 | (setq edebug-backtrace-buffer |
| 4063 | (generate-new-buffer "*Backtrace*")) | 4051 | (generate-new-buffer "*Backtrace*")) |
| 4064 | ;; else, could just display edebug-backtrace-buffer | 4052 | ;; Else, could just display edebug-backtrace-buffer. |
| 4065 | ) | 4053 | ) |
| 4066 | (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) | 4054 | (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) |
| 4067 | (setq edebug-backtrace-buffer standard-output) | 4055 | (setq edebug-backtrace-buffer standard-output) |
| @@ -4083,7 +4071,7 @@ Otherwise call `debug' normally." | |||
| 4083 | (beginning-of-line) | 4071 | (beginning-of-line) |
| 4084 | (cond | 4072 | (cond |
| 4085 | ((looking-at "^ \(edebug-after") | 4073 | ((looking-at "^ \(edebug-after") |
| 4086 | ;; Previous lines may contain code, so just delete this line | 4074 | ;; Previous lines may contain code, so just delete this line. |
| 4087 | (setq last-ok-point (point)) | 4075 | (setq last-ok-point (point)) |
| 4088 | (forward-line 1) | 4076 | (forward-line 1) |
| 4089 | (delete-region last-ok-point (point))) | 4077 | (delete-region last-ok-point (point))) |