Commit | Line | Data |
---|---|---|
bd8d6108 | 1 | ;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*- |
84fc2cfa | 2 | |
ab422c4d PE |
3 | ;; Copyright (C) 1988-1995, 1997, 1999-2013 Free Software Foundation, |
4 | ;; Inc. | |
84fc2cfa | 5 | |
f367dfc1 | 6 | ;; Author: Daniel LaLiberte <liberte@holonexus.org> |
c86b5c78 | 7 | ;; Maintainer: FSF |
e9571d2a | 8 | ;; Keywords: lisp, tools, maint |
3a801d0c | 9 | |
84fc2cfa ER |
10 | ;; This file is part of GNU Emacs. |
11 | ||
d6cba7ae | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
1fe3d507 | 13 | ;; it under the terms of the GNU General Public License as published by |
d6cba7ae GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
1fe3d507 | 16 | |
84fc2cfa | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
1fe3d507 DL |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
d6cba7ae | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
f7359658 RS |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; This minor mode allows programmers to step through Emacs Lisp | |
28 | ;; source code while executing functions. You can also set | |
29 | ;; breakpoints, trace (stopping at each expression), evaluate | |
30 | ;; expressions as if outside Edebug, reevaluate and display a list of | |
31 | ;; expressions, trap errors normally caught by debug, and display a | |
32 | ;; debug style backtrace. | |
33 | ||
f7359658 RS |
34 | ;;; Minimal Instructions |
35 | ;; ===================== | |
36 | ||
6392137f | 37 | ;; First evaluate a defun with C-M-x, then run the function. Step |
f7359658 RS |
38 | ;; through the code with SPC, mark breakpoints with b, go until a |
39 | ;; breakpoint is reached with g, and quit execution with q. Use the | |
a1506d29 | 40 | ;; "?" command in edebug to describe other commands. |
c86b5c78 | 41 | ;; See the Emacs Lisp Reference Manual for more details. |
6392137f KH |
42 | |
43 | ;; If you wish to change the default edebug global command prefix, change: | |
44 | ;; (setq edebug-global-prefix "\C-xX") | |
f7359658 | 45 | |
c86b5c78 RS |
46 | ;; Edebug was written by |
47 | ;; Daniel LaLiberte | |
6392137f KH |
48 | ;; GTE Labs |
49 | ;; 40 Sylvan Rd | |
50 | ;; Waltham, MA 02254 | |
f367dfc1 | 51 | ;; liberte@holonexus.org |
f7359658 RS |
52 | |
53 | ;;; Code: | |
1fe3d507 | 54 | |
4dd1c416 | 55 | (require 'macroexp) |
2de39f08 | 56 | (eval-when-compile (require 'cl-lib)) |
17c781d1 | 57 | (eval-when-compile (require 'pcase)) |
1fe3d507 | 58 | |
f7359658 | 59 | ;;; Options |
1fe3d507 | 60 | |
c5292bc8 | 61 | (defgroup edebug nil |
ea400c88 | 62 | "A source-level debugger for Emacs Lisp." |
c5292bc8 RS |
63 | :group 'lisp) |
64 | ||
65 | ||
66 | (defcustom edebug-setup-hook nil | |
242b1f68 | 67 | "Functions to call before edebug is used. |
a50d4326 | 68 | Each time it is set to a new value, Edebug will call those functions |
1e46f9e4 | 69 | once and then reset `edebug-setup-hook' to nil. You could use this |
a50d4326 | 70 | to load up Edebug specifications associated with a package you are |
1e46f9e4 | 71 | using, but only when you also use Edebug." |
c5292bc8 RS |
72 | :type 'hook |
73 | :group 'edebug) | |
1fe3d507 | 74 | |
36f8d564 RS |
75 | ;; edebug-all-defs and edebug-all-forms need to be autoloaded |
76 | ;; because the byte compiler binds them; as a result, if edebug | |
77 | ;; is first loaded for a require in a compilation, they will be left unbound. | |
78 | ||
79 | ;;;###autoload | |
c5292bc8 | 80 | (defcustom edebug-all-defs nil |
242b1f68 | 81 | "If non-nil, evaluating defining forms instruments for Edebug. |
a50d4326 DL |
82 | This applies to `eval-defun', `eval-region', `eval-buffer', and |
83 | `eval-current-buffer'. `eval-region' is also called by | |
1fe3d507 DL |
84 | `eval-last-sexp', and `eval-print-last-sexp'. |
85 | ||
86 | You can use the command `edebug-all-defs' to toggle the value of this | |
a50d4326 | 87 | variable. You may wish to make it local to each buffer with |
f7359658 | 88 | \(make-local-variable 'edebug-all-defs) in your |
c5292bc8 RS |
89 | `emacs-lisp-mode-hook'." |
90 | :type 'boolean | |
91 | :group 'edebug) | |
1fe3d507 | 92 | |
36f8d564 RS |
93 | ;; edebug-all-defs and edebug-all-forms need to be autoloaded |
94 | ;; because the byte compiler binds them; as a result, if edebug | |
95 | ;; is first loaded for a require in a compilation, they will be left unbound. | |
96 | ||
97 | ;;;###autoload | |
c5292bc8 | 98 | (defcustom edebug-all-forms nil |
1e46f9e4 | 99 | "Non-nil means evaluation of all forms will instrument for Edebug. |
1fe3d507 | 100 | This doesn't apply to loading or evaluations in the minibuffer. |
c5292bc8 RS |
101 | Use the command `edebug-all-forms' to toggle the value of this option." |
102 | :type 'boolean | |
103 | :group 'edebug) | |
84fc2cfa | 104 | |
c5292bc8 | 105 | (defcustom edebug-eval-macro-args nil |
242b1f68 | 106 | "Non-nil means all macro call arguments may be evaluated. |
f7359658 | 107 | If this variable is nil, the default, Edebug will *not* wrap |
a1506d29 | 108 | macro call arguments as if they will be evaluated. |
1e46f9e4 | 109 | For each macro, an `edebug-form-spec' overrides this option. |
1fe3d507 | 110 | So to specify exceptions for macros that have some arguments evaluated |
1e46f9e4 | 111 | and some not, use `def-edebug-spec' to specify an `edebug-form-spec'." |
c5292bc8 RS |
112 | :type 'boolean |
113 | :group 'edebug) | |
84fc2cfa | 114 | |
c5292bc8 | 115 | (defcustom edebug-save-windows t |
242b1f68 | 116 | "If non-nil, Edebug saves and restores the window configuration. |
a50d4326 DL |
117 | That takes some time, so if your program does not care what happens to |
118 | the window configurations, it is better to set this variable to nil. | |
1fe3d507 DL |
119 | |
120 | If the value is a list, only the listed windows are saved and | |
a1506d29 | 121 | restored. |
84fc2cfa | 122 | |
c5292bc8 RS |
123 | `edebug-toggle-save-windows' may be used to change this variable." |
124 | :type '(choice boolean (repeat string)) | |
125 | :group 'edebug) | |
84fc2cfa | 126 | |
c5292bc8 | 127 | (defcustom edebug-save-displayed-buffer-points nil |
242b1f68 | 128 | "If non-nil, save and restore point in all displayed buffers. |
84fc2cfa | 129 | |
a50d4326 | 130 | Saving and restoring point in other buffers is necessary if you are |
1e46f9e4 | 131 | debugging code that changes the point of a buffer that is displayed |
a50d4326 | 132 | in a non-selected window. If Edebug or the user then selects the |
84fc2cfa ER |
133 | window, the buffer's point will be changed to the window's point. |
134 | ||
a50d4326 | 135 | Saving and restoring point in all buffers is expensive, since it |
1e46f9e4 GM |
136 | requires selecting each window twice, so enable this only if you |
137 | need it." | |
c5292bc8 RS |
138 | :type 'boolean |
139 | :group 'edebug) | |
84fc2cfa | 140 | |
c5292bc8 | 141 | (defcustom edebug-initial-mode 'step |
242b1f68 | 142 | "Initial execution mode for Edebug, if non-nil. |
b6386e63 LT |
143 | If this variable is non-nil, it specifies the initial execution mode |
144 | for Edebug when it is first activated. Possible values are step, next, | |
145 | go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast." | |
c5292bc8 RS |
146 | :type '(choice (const step) (const next) (const go) |
147 | (const Go-nonstop) (const trace) | |
148 | (const Trace-fast) (const continue) | |
7ff1b00e | 149 | (const Continue-fast)) |
c5292bc8 RS |
150 | :group 'edebug) |
151 | ||
152 | (defcustom edebug-trace nil | |
242b1f68 | 153 | "Non-nil means display a trace of function entry and exit. |
a50d4326 | 154 | Tracing output is displayed in a buffer named `*edebug-trace*', one |
a1506d29 | 155 | function entry or exit per line, indented by the recursion level. |
a50d4326 DL |
156 | |
157 | You can customize by replacing functions `edebug-print-trace-before' | |
c5292bc8 RS |
158 | and `edebug-print-trace-after'." |
159 | :type 'boolean | |
160 | :group 'edebug) | |
84fc2cfa | 161 | |
c5292bc8 | 162 | (defcustom edebug-test-coverage nil |
242b1f68 JB |
163 | "If non-nil, Edebug tests coverage of all expressions debugged. |
164 | This is done by comparing the result of each expression with the | |
165 | previous result. Coverage is considered OK if two different | |
a50d4326 | 166 | results are found. |
84fc2cfa | 167 | |
1fe3d507 | 168 | Use `edebug-display-freq-count' to display the frequency count and |
c5292bc8 RS |
169 | coverage information for a definition." |
170 | :type 'boolean | |
171 | :group 'edebug) | |
1fe3d507 | 172 | |
c5292bc8 | 173 | (defcustom edebug-continue-kbd-macro nil |
242b1f68 | 174 | "If non-nil, continue defining or executing any keyboard macro. |
c5292bc8 RS |
175 | Use this with caution since it is not debugged." |
176 | :type 'boolean | |
177 | :group 'edebug) | |
178 | ||
179 | ||
180 | (defcustom edebug-print-length 50 | |
1e46f9e4 | 181 | "If non-nil, default value of `print-length' for printing results in Edebug." |
c5292bc8 RS |
182 | :type 'integer |
183 | :group 'edebug) | |
184 | (defcustom edebug-print-level 50 | |
1e46f9e4 | 185 | "If non-nil, default value of `print-level' for printing results in Edebug." |
c5292bc8 RS |
186 | :type 'integer |
187 | :group 'edebug) | |
188 | (defcustom edebug-print-circle t | |
1e46f9e4 | 189 | "If non-nil, default value of `print-circle' for printing results in Edebug." |
c5292bc8 RS |
190 | :type 'boolean |
191 | :group 'edebug) | |
192 | ||
193 | (defcustom edebug-unwrap-results nil | |
242b1f68 | 194 | "Non-nil if Edebug should unwrap results of expressions. |
0b021094 | 195 | That is, Edebug will try to remove its own instrumentation from the result. |
1fe3d507 DL |
196 | This is useful when debugging macros where the results of expressions |
197 | are instrumented expressions. But don't do this when results might be | |
c5292bc8 RS |
198 | circular or an infinite loop will result." |
199 | :type 'boolean | |
200 | :group 'edebug) | |
1fe3d507 | 201 | |
c5292bc8 | 202 | (defcustom edebug-on-error t |
242b1f68 | 203 | "Value bound to `debug-on-error' while Edebug is active. |
1fe3d507 DL |
204 | |
205 | If `debug-on-error' is non-nil, that value is still used. | |
206 | ||
207 | If the value is a list of signal names, Edebug will stop when any of | |
208 | these errors are signaled from Lisp code whether or not the signal is | |
209 | handled by a `condition-case'. This option is useful for debugging | |
210 | signals that *are* handled since they would otherwise be missed. | |
c5292bc8 | 211 | After execution is resumed, the error is signaled again." |
7ff1b00e AS |
212 | :type '(choice (const :tag "off") |
213 | (repeat :menu-tag "When" | |
214 | :value (nil) | |
215 | (symbol :format "%v")) | |
216 | (const :tag "always" t)) | |
c5292bc8 | 217 | :group 'edebug) |
1fe3d507 | 218 | |
c5292bc8 | 219 | (defcustom edebug-on-quit t |
242b1f68 | 220 | "Value bound to `debug-on-quit' while Edebug is active." |
c5292bc8 RS |
221 | :type 'boolean |
222 | :group 'edebug) | |
1fe3d507 | 223 | |
c5292bc8 | 224 | (defcustom edebug-global-break-condition nil |
242b1f68 | 225 | "If non-nil, an expression to test for at every stop point. |
c5292bc8 RS |
226 | If the result is non-nil, then break. Errors are ignored." |
227 | :type 'sexp | |
228 | :group 'edebug) | |
a50d4326 | 229 | |
5492ef3c | 230 | (defcustom edebug-sit-for-seconds 1 |
1e46f9e4 | 231 | "Number of seconds to pause when execution mode is `trace' or `continue'." |
5492ef3c RS |
232 | :type 'number |
233 | :group 'edebug) | |
234 | ||
f7359658 | 235 | ;;; Form spec utilities. |
1fe3d507 | 236 | |
1fe3d507 DL |
237 | (defun get-edebug-spec (symbol) |
238 | ;; Get the spec of symbol resolving all indirection. | |
bd8d6108 | 239 | (let ((spec nil) |
7abaf5cc SM |
240 | (indirect symbol)) |
241 | (while | |
242 | (progn | |
243 | (and (symbolp indirect) | |
244 | (setq indirect | |
3c98c962 | 245 | (function-get indirect 'edebug-form-spec 'macro)))) |
1fe3d507 | 246 | ;; (edebug-trace "indirection: %s" edebug-form-spec) |
bd8d6108 SM |
247 | (setq spec indirect)) |
248 | spec)) | |
1fe3d507 | 249 | |
65d04e76 EZ |
250 | ;;;###autoload |
251 | (defun edebug-basic-spec (spec) | |
252 | "Return t if SPEC uses only extant spec symbols. | |
253 | An extant spec symbol is a symbol that is not a function and has a | |
254 | `edebug-form-spec' property." | |
255 | (cond ((listp spec) | |
256 | (catch 'basic | |
257 | (while spec | |
258 | (unless (edebug-basic-spec (car spec)) (throw 'basic nil)) | |
259 | (setq spec (cdr spec))) | |
260 | t)) | |
261 | ((symbolp spec) | |
7abaf5cc | 262 | (unless (functionp spec) (function-get spec 'edebug-form-spec))))) |
65d04e76 | 263 | |
f7359658 | 264 | ;;; Utilities |
1fe3d507 | 265 | |
f7359658 RS |
266 | ;; Define edebug-gensym - from old cl.el |
267 | (defvar edebug-gensym-index 0 | |
268 | "Integer used by `edebug-gensym' to produce new names.") | |
1fe3d507 | 269 | |
f7359658 | 270 | (defun edebug-gensym (&optional prefix) |
1fe3d507 | 271 | "Generate a fresh uninterned symbol. |
242b1f68 JB |
272 | There is an optional argument, PREFIX. PREFIX is the string |
273 | that begins the new name. Most people take just the default, | |
1fe3d507 DL |
274 | except when debugging needs suggest otherwise." |
275 | (if (null prefix) | |
276 | (setq prefix "G")) | |
277 | (let ((newsymbol nil) | |
278 | (newname "")) | |
279 | (while (not newsymbol) | |
f7359658 RS |
280 | (setq newname (concat prefix (int-to-string edebug-gensym-index))) |
281 | (setq edebug-gensym-index (+ edebug-gensym-index 1)) | |
1fe3d507 DL |
282 | (if (not (intern-soft newname)) |
283 | (setq newsymbol (make-symbol newname)))) | |
284 | newsymbol)) | |
1fe3d507 | 285 | |
f7359658 | 286 | (defun edebug-lambda-list-keywordp (object) |
1fe3d507 | 287 | "Return t if OBJECT is a lambda list keyword. |
f7359658 | 288 | A lambda list keyword is a symbol that starts with `&'." |
1fe3d507 DL |
289 | (and (symbolp object) |
290 | (= ?& (aref (symbol-name object) 0)))) | |
84fc2cfa | 291 | |
84fc2cfa ER |
292 | |
293 | (defun edebug-last-sexp () | |
1fe3d507 | 294 | ;; Return the last sexp before point in current buffer. |
f7359658 | 295 | ;; Assumes Emacs Lisp syntax is active. |
84fc2cfa ER |
296 | (car |
297 | (read-from-string | |
298 | (buffer-substring | |
299 | (save-excursion | |
300 | (forward-sexp -1) | |
301 | (point)) | |
302 | (point))))) | |
303 | ||
304 | (defun edebug-window-list () | |
f7359658 RS |
305 | "Return a list of windows, in order of `next-window'." |
306 | ;; This doesn't work for epoch. | |
e940c6da | 307 | (let (window-list) |
d778509c | 308 | (walk-windows (lambda (w) (push w window-list))) |
84fc2cfa ER |
309 | (nreverse window-list))) |
310 | ||
1fe3d507 DL |
311 | ;; Not used. |
312 | '(defun edebug-two-window-p () | |
84fc2cfa ER |
313 | "Return t if there are two windows." |
314 | (and (not (one-window-p)) | |
315 | (eq (selected-window) | |
316 | (next-window (next-window (selected-window)))))) | |
317 | ||
1fe3d507 | 318 | (defsubst edebug-lookup-function (object) |
84fc2cfa ER |
319 | (while (and (symbolp object) (fboundp object)) |
320 | (setq object (symbol-function object))) | |
1fe3d507 | 321 | object) |
a1506d29 | 322 | |
1fe3d507 DL |
323 | (defun edebug-macrop (object) |
324 | "Return the macro named by OBJECT, or nil if it is not a macro." | |
325 | (setq object (edebug-lookup-function object)) | |
84fc2cfa ER |
326 | (if (and (listp object) |
327 | (eq 'macro (car object)) | |
d778509c | 328 | (functionp (cdr object))) |
84fc2cfa ER |
329 | object)) |
330 | ||
331 | (defun edebug-sort-alist (alist function) | |
1fe3d507 DL |
332 | ;; Return the ALIST sorted with comparison function FUNCTION. |
333 | ;; This uses 'sort so the sorting is destructive. | |
84fc2cfa ER |
334 | (sort alist (function |
335 | (lambda (e1 e2) | |
336 | (funcall function (car e1) (car e2)))))) | |
337 | ||
bd8d6108 | 338 | ;; Not used. |
1fe3d507 | 339 | '(defmacro edebug-save-restriction (&rest body) |
84fc2cfa ER |
340 | "Evaluate BODY while saving the current buffers restriction. |
341 | BODY may change buffer outside of current restriction, unlike | |
342 | save-restriction. BODY may change the current buffer, | |
343 | and the restriction will be restored to the original buffer, | |
344 | and the current buffer remains current. | |
345 | Return the result of the last expression in BODY." | |
bd8d6108 | 346 | (declare (debug t)) |
d8f1319a GM |
347 | `(let ((edebug:s-r-beg (point-min-marker)) |
348 | (edebug:s-r-end (point-max-marker))) | |
349 | (unwind-protect | |
350 | (progn ,@body) | |
de70529f | 351 | (with-current-buffer (marker-buffer edebug:s-r-beg) |
d8f1319a | 352 | (narrow-to-region edebug:s-r-beg edebug:s-r-end))))) |
84fc2cfa | 353 | |
f7359658 | 354 | ;;; Display |
1fe3d507 DL |
355 | |
356 | (defconst edebug-trace-buffer "*edebug-trace*" | |
357 | "Name of the buffer to put trace info in.") | |
358 | ||
359 | (defun edebug-pop-to-buffer (buffer &optional window) | |
360 | ;; Like pop-to-buffer, but select window where BUFFER was last shown. | |
c8286c2c | 361 | ;; Select WINDOW if it is provided and still exists. Otherwise, |
1fe3d507 DL |
362 | ;; if buffer is currently shown in several windows, choose one. |
363 | ;; Otherwise, find a new window, possibly splitting one. | |
2de39f08 | 364 | ;; FIXME: We should probably just be using `pop-to-buffer'. |
c8286c2c MR |
365 | (setq window |
366 | (cond | |
1b96c77f | 367 | ((and (edebug-window-live-p window) |
c8286c2c MR |
368 | (eq (window-buffer window) buffer)) |
369 | window) | |
370 | ((eq (window-buffer (selected-window)) buffer) | |
371 | ;; Selected window already displays BUFFER. | |
372 | (selected-window)) | |
2de39f08 | 373 | ((get-buffer-window buffer 0)) |
c8286c2c MR |
374 | ((one-window-p 'nomini) |
375 | ;; When there's one window only, split it. | |
6a088630 | 376 | (split-window (minibuffer-selected-window))) |
c8286c2c MR |
377 | ((let ((trace-window (get-buffer-window edebug-trace-buffer))) |
378 | (catch 'found | |
379 | (dolist (elt (window-list nil 'nomini)) | |
380 | (unless (or (eq elt (selected-window)) (eq elt trace-window) | |
381 | (window-dedicated-p elt)) | |
382 | ;; Found a non-dedicated window not showing | |
383 | ;; `edebug-trace-buffer', use it. | |
384 | (throw 'found elt)))))) | |
385 | ;; All windows are dedicated or show `edebug-trace-buffer', split | |
386 | ;; selected one. | |
6a088630 | 387 | (t (split-window (minibuffer-selected-window))))) |
c8286c2c | 388 | (set-window-buffer window buffer) |
6bab5d8b MR |
389 | (select-window window) |
390 | (set-window-hscroll window 0)) ;; should this be?? | |
84fc2cfa | 391 | |
1fe3d507 DL |
392 | (defun edebug-get-displayed-buffer-points () |
393 | ;; Return a list of buffer point pairs, for all displayed buffers. | |
e940c6da GM |
394 | (let (list) |
395 | (walk-windows (lambda (w) | |
396 | (unless (eq w (selected-window)) | |
d778509c SM |
397 | (push (cons (window-buffer w) |
398 | (window-point w)) | |
399 | list)))) | |
e940c6da | 400 | list)) |
1fe3d507 DL |
401 | |
402 | ||
403 | (defun edebug-set-buffer-points (buffer-points) | |
404 | ;; Restore the buffer-points created by edebug-get-displayed-buffer-points. | |
d778509c SM |
405 | (save-current-buffer |
406 | (mapcar (lambda (buf-point) | |
407 | (when (buffer-live-p (car buf-point)) | |
408 | (set-buffer (car buf-point)) | |
409 | (goto-char (cdr buf-point)))) | |
410 | buffer-points))) | |
1fe3d507 DL |
411 | |
412 | (defun edebug-current-windows (which-windows) | |
413 | ;; Get either a full window configuration or some window information. | |
414 | (if (listp which-windows) | |
415 | (mapcar (function (lambda (window) | |
416 | (if (edebug-window-live-p window) | |
417 | (list window | |
418 | (window-buffer window) | |
419 | (window-point window) | |
420 | (window-start window) | |
421 | (window-hscroll window))))) | |
422 | which-windows) | |
423 | (current-window-configuration))) | |
424 | ||
425 | (defun edebug-set-windows (window-info) | |
426 | ;; Set either a full window configuration or some window information. | |
427 | (if (listp window-info) | |
a1506d29 | 428 | (mapcar (function |
1fe3d507 DL |
429 | (lambda (one-window-info) |
430 | (if one-window-info | |
a1506d29 | 431 | (apply (function |
1fe3d507 DL |
432 | (lambda (window buffer point start hscroll) |
433 | (if (edebug-window-live-p window) | |
434 | (progn | |
435 | (set-window-buffer window buffer) | |
436 | (set-window-point window point) | |
437 | (set-window-start window start) | |
438 | (set-window-hscroll window hscroll))))) | |
439 | one-window-info)))) | |
440 | window-info) | |
441 | (set-window-configuration window-info))) | |
442 | ||
f7359658 RS |
443 | ;;; Redefine read and eval functions |
444 | ;; read is redefined to maybe instrument forms. | |
445 | ;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs. | |
1fe3d507 | 446 | |
1fe3d507 | 447 | ;; Save the original read function |
2de39f08 SM |
448 | (defalias 'edebug-original-read |
449 | (symbol-function (if (fboundp 'edebug-original-read) | |
450 | 'edebug-original-read 'read))) | |
1fe3d507 | 451 | |
88668147 DL |
452 | (defun edebug-read (&optional stream) |
453 | "Read one Lisp expression as text from STREAM, return as Lisp object. | |
454 | If STREAM is nil, use the value of `standard-input' (which see). | |
455 | STREAM or the value of `standard-input' may be: | |
456 | a buffer (read from point and advance it) | |
457 | a marker (read from where it points and advance it) | |
458 | a function (call it with no arguments for each character, | |
459 | call it with a char as argument to push a char back) | |
460 | a string (takes text from string, starting at the beginning) | |
461 | t (read text line using minibuffer and use it). | |
462 | ||
242b1f68 | 463 | This version, from Edebug, maybe instruments the expression. But the |
f7359658 | 464 | STREAM must be the current buffer to do so. Whether it instruments is |
9fc9a531 AH |
465 | also dependent on the values of the option `edebug-all-defs' and |
466 | the option `edebug-all-forms'." | |
88668147 DL |
467 | (or stream (setq stream standard-input)) |
468 | (if (eq stream (current-buffer)) | |
1fe3d507 DL |
469 | (edebug-read-and-maybe-wrap-form) |
470 | (edebug-original-read stream))) | |
471 | ||
1fe3d507 DL |
472 | (or (fboundp 'edebug-original-eval-defun) |
473 | (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun))) | |
474 | ||
781b4af6 SM |
475 | (defvar edebug-result) ; The result of the function call returned by body. |
476 | ||
f7359658 RS |
477 | ;; We should somehow arrange to be able to do this |
478 | ;; without actually replacing the eval-defun command. | |
1fe3d507 DL |
479 | (defun edebug-eval-defun (edebug-it) |
480 | "Evaluate the top-level form containing point, or after point. | |
481 | ||
44b6285e GM |
482 | If the current defun is actually a call to `defvar', then reset the |
483 | variable using its initial value expression even if the variable | |
484 | already has some other value. (Normally `defvar' does not change the | |
95e4aa8e JL |
485 | variable's value if it already has a value.) Treat `defcustom' |
486 | similarly. Reinitialize the face according to `defface' specification. | |
44b6285e GM |
487 | |
488 | With a prefix argument, instrument the code for Edebug. | |
489 | ||
9fc9a531 AH |
490 | Setting option `edebug-all-defs' to a non-nil value reverses the meaning |
491 | of the prefix argument. Code is then instrumented when this function is | |
781b4af6 | 492 | invoked without a prefix argument. |
44b6285e | 493 | |
242b1f68 JB |
494 | If acting on a `defun' for FUNCTION, and the function was instrumented, |
495 | `Edebug: FUNCTION' is printed in the minibuffer. If not instrumented, | |
496 | just FUNCTION is printed. | |
44b6285e GM |
497 | |
498 | If not acting on a `defun', the result of evaluation is displayed in | |
499 | the minibuffer." | |
1fe3d507 | 500 | (interactive "P") |
f7359658 RS |
501 | (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs)))) |
502 | (edebug-result) | |
503 | (form | |
504 | (let ((edebug-all-forms edebugging) | |
505 | (edebug-all-defs (eq edebug-all-defs (not edebug-it)))) | |
506 | (edebug-read-top-level-form)))) | |
e75667a0 | 507 | ;; This should be consistent with `eval-defun-1', but not the |
0c4a4faa | 508 | ;; same, since that gets a macroexpanded form. |
6b339332 DL |
509 | (cond ((and (eq (car form) 'defvar) |
510 | (cdr-safe (cdr-safe form))) | |
511 | ;; Force variable to be bound. | |
0c4a4faa | 512 | (makunbound (nth 1 form))) |
6b339332 DL |
513 | ((and (eq (car form) 'defcustom) |
514 | (default-boundp (nth 1 form))) | |
515 | ;; Force variable to be bound. | |
06788a55 | 516 | ;; FIXME: Shouldn't this use the :setter or :initializer? |
a0ee6f27 | 517 | (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) |
95e4aa8e JL |
518 | ((eq (car form) 'defface) |
519 | ;; Reset the face. | |
95e4aa8e | 520 | (setq face-new-frame-defaults |
7cbb6dad JL |
521 | (assq-delete-all (nth 1 form) face-new-frame-defaults)) |
522 | (put (nth 1 form) 'face-defface-spec nil) | |
e4d4f539 | 523 | (put (nth 1 form) 'face-documentation (nth 3 form)) |
7cbb6dad JL |
524 | ;; See comments in `eval-defun-1' for purpose of code below |
525 | (setq form (prog1 `(prog1 ,form | |
526 | (put ',(nth 1 form) 'saved-face | |
527 | ',(get (nth 1 form) 'saved-face)) | |
528 | (put ',(nth 1 form) 'customized-face | |
45cbf2fe | 529 | ,(nth 2 form))) |
7cbb6dad | 530 | (put (nth 1 form) 'saved-face nil))))) |
06788a55 | 531 | (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding)) |
1fe3d507 DL |
532 | (if (not edebugging) |
533 | (princ edebug-result) | |
534 | edebug-result))) | |
535 | ||
536 | ||
537 | ;;;###autoload | |
538 | (defalias 'edebug-defun 'edebug-eval-top-level-form) | |
539 | ||
540 | ;;;###autoload | |
541 | (defun edebug-eval-top-level-form () | |
1f1b7f93 RS |
542 | "Evaluate the top level form point is in, stepping through with Edebug. |
543 | This is like `eval-defun' except that it steps the code for Edebug | |
544 | before evaluating it. It displays the value in the echo area | |
545 | using `eval-expression' (which see). | |
546 | ||
242b1f68 JB |
547 | If you do this on a function definition such as a defun or defmacro, |
548 | it defines the function and instruments its definition for Edebug, | |
549 | so it will do Edebug stepping when called later. It displays | |
550 | `Edebug: FUNCTION' in the echo area to indicate that FUNCTION is now | |
551 | instrumented for Edebug. | |
1f1b7f93 RS |
552 | |
553 | If the current defun is actually a call to `defvar' or `defcustom', | |
554 | evaluating it this way resets the variable using its initial value | |
555 | expression even if the variable already has some other value. | |
556 | \(Normally `defvar' and `defcustom' do not alter the value if there | |
557 | already is one.)" | |
84fc2cfa | 558 | (interactive) |
1f1b7f93 | 559 | (eval-expression |
f7359658 | 560 | ;; Bind edebug-all-forms only while reading, not while evalling |
1fe3d507 | 561 | ;; but this causes problems while edebugging edebug. |
88668147 DL |
562 | (let ((edebug-all-forms t) |
563 | (edebug-all-defs t)) | |
f488fb65 SM |
564 | (eval-sexp-add-defvars |
565 | (edebug-read-top-level-form))))) | |
84fc2cfa ER |
566 | |
567 | ||
1fe3d507 DL |
568 | (defun edebug-read-top-level-form () |
569 | (let ((starting-point (point))) | |
570 | (end-of-defun) | |
571 | (beginning-of-defun) | |
572 | (prog1 | |
573 | (edebug-read-and-maybe-wrap-form) | |
574 | ;; Recover point, but only if no error occurred. | |
575 | (goto-char starting-point)))) | |
84fc2cfa | 576 | |
84fc2cfa | 577 | |
1fe3d507 DL |
578 | ;; Compatibility with old versions. |
579 | (defalias 'edebug-all-defuns 'edebug-all-defs) | |
84fc2cfa | 580 | |
eb533587 | 581 | ;;;###autoload |
1fe3d507 DL |
582 | (defun edebug-all-defs () |
583 | "Toggle edebugging of all definitions." | |
584 | (interactive) | |
585 | (setq edebug-all-defs (not edebug-all-defs)) | |
a1506d29 | 586 | (message "Edebugging all definitions is %s." |
1fe3d507 | 587 | (if edebug-all-defs "on" "off"))) |
84fc2cfa | 588 | |
84fc2cfa | 589 | |
eb533587 | 590 | ;;;###autoload |
1fe3d507 DL |
591 | (defun edebug-all-forms () |
592 | "Toggle edebugging of all forms." | |
593 | (interactive) | |
594 | (setq edebug-all-forms (not edebug-all-forms)) | |
a1506d29 | 595 | (message "Edebugging all forms is %s." |
1fe3d507 | 596 | (if edebug-all-forms "on" "off"))) |
84fc2cfa ER |
597 | |
598 | ||
1fe3d507 | 599 | (defun edebug-install-read-eval-functions () |
1c222bca | 600 | (interactive) |
88668147 | 601 | ;; Don't install if already installed. |
faa5fa58 DL |
602 | (unless load-read-function |
603 | (setq load-read-function 'edebug-read) | |
88668147 | 604 | (defalias 'eval-defun 'edebug-eval-defun))) |
daa37602 | 605 | |
1fe3d507 DL |
606 | (defun edebug-uninstall-read-eval-functions () |
607 | (interactive) | |
faa5fa58 | 608 | (setq load-read-function nil) |
88668147 | 609 | (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun))) |
1fe3d507 DL |
610 | |
611 | ||
f7359658 | 612 | ;;; Edebug internal data |
1fe3d507 | 613 | |
f7359658 | 614 | ;; The internal data that is needed for edebugging is kept in the |
a1506d29 | 615 | ;; buffer-local variable `edebug-form-data'. |
1fe3d507 | 616 | |
bd8d6108 SM |
617 | (defvar-local edebug-form-data nil |
618 | "A list of entries associating symbols with buffer regions. | |
2de39f08 SM |
619 | Each entry is an `edebug--form-data' struct with fields: |
620 | SYMBOL, BEGIN-MARKER, and END-MARKER. The markers | |
bd8d6108 SM |
621 | are at the beginning and end of an entry level form and SYMBOL is |
622 | a symbol that holds all edebug related information for the form on its | |
623 | property list. | |
1fe3d507 | 624 | |
bd8d6108 SM |
625 | In the future (haha!), the symbol will be irrelevant and edebug data will |
626 | be stored in the definitions themselves rather than in the property | |
627 | list of a symbol.") | |
1fe3d507 | 628 | |
2de39f08 SM |
629 | (cl-defstruct (edebug--form-data |
630 | ;; Some callers expect accessors to return nil when passed nil. | |
631 | (:type list) | |
632 | (:constructor edebug--make-form-data-entry (name begin end)) | |
633 | (:predicate nil) (:constructor nil) (:copier nil)) | |
634 | name begin end) | |
1fe3d507 DL |
635 | |
636 | (defsubst edebug-set-form-data-entry (entry name begin end) | |
2de39f08 SM |
637 | (setf (edebug--form-data-name entry) name) ;; In case name is changed. |
638 | (set-marker (edebug--form-data-begin entry) begin) | |
639 | (set-marker (edebug--form-data-end entry) end)) | |
1fe3d507 DL |
640 | |
641 | (defun edebug-get-form-data-entry (pnt &optional end-point) | |
642 | ;; Find the edebug form data entry which is closest to PNT. | |
643 | ;; If END-POINT is supplied, match must be exact. | |
644 | ;; Return `nil' if none found. | |
645 | (let ((rest edebug-form-data) | |
646 | closest-entry | |
2de39f08 | 647 | (closest-dist 999999)) ;; Need maxint here. |
1fe3d507 DL |
648 | (while (and rest (< 0 closest-dist)) |
649 | (let* ((entry (car rest)) | |
2de39f08 | 650 | (begin (edebug--form-data-begin entry)) |
1fe3d507 DL |
651 | (dist (- pnt begin))) |
652 | (setq rest (cdr rest)) | |
653 | (if (and (<= 0 dist) | |
654 | (< dist closest-dist) | |
655 | (or (not end-point) | |
2de39f08 SM |
656 | (= end-point (edebug--form-data-end entry))) |
657 | (<= pnt (edebug--form-data-end entry))) | |
1fe3d507 DL |
658 | (setq closest-dist dist |
659 | closest-entry entry)))) | |
660 | closest-entry)) | |
661 | ||
662 | ;; Also need to find all contained entries, | |
663 | ;; and find an entry given a symbol, which should be just assq. | |
664 | ||
665 | (defun edebug-form-data-symbol () | |
2de39f08 SM |
666 | "Return the edebug data symbol of the form where point is in. |
667 | If point is not inside a edebuggable form, cause error." | |
668 | (or (edebug--form-data-name (edebug-get-form-data-entry (point))) | |
1fe3d507 DL |
669 | (error "Not inside instrumented form"))) |
670 | ||
671 | (defun edebug-make-top-form-data-entry (new-entry) | |
672 | ;; Make NEW-ENTRY the first element in the `edebug-form-data' list. | |
673 | (edebug-clear-form-data-entry new-entry) | |
2de39f08 | 674 | (push new-entry edebug-form-data)) |
1fe3d507 DL |
675 | |
676 | (defun edebug-clear-form-data-entry (entry) | |
2de39f08 SM |
677 | "If non-nil, clear ENTRY out of the form data. |
678 | Maybe clear the markers and delete the symbol's edebug property?" | |
1fe3d507 DL |
679 | (if entry |
680 | (progn | |
a1506d29 JB |
681 | ;; Instead of this, we could just find all contained forms. |
682 | ;; (put (car entry) 'edebug nil) ; | |
1fe3d507 DL |
683 | ;; (mapcar 'edebug-clear-form-data-entry ; dangerous |
684 | ;; (get (car entry) 'edebug-dependents)) | |
685 | ;; (set-marker (nth 1 entry) nil) | |
686 | ;; (set-marker (nth 2 entry) nil) | |
687 | (setq edebug-form-data (delq entry edebug-form-data))))) | |
daa37602 | 688 | |
f7359658 | 689 | ;;; Parser utilities |
1fe3d507 DL |
690 | |
691 | (defun edebug-syntax-error (&rest args) | |
692 | ;; Signal an invalid-read-syntax with ARGS. | |
693 | (signal 'invalid-read-syntax args)) | |
694 | ||
84fc2cfa | 695 | |
1fe3d507 DL |
696 | (defconst edebug-read-syntax-table |
697 | ;; Lookup table for significant characters indicating the class of the | |
698 | ;; token that follows. This is not a \"real\" syntax table. | |
0b936a1e | 699 | (let ((table (make-char-table 'syntax-table 'symbol)) |
1fe3d507 DL |
700 | (i 0)) |
701 | (while (< i ?!) | |
702 | (aset table i 'space) | |
703 | (setq i (1+ i))) | |
704 | (aset table ?\( 'lparen) | |
705 | (aset table ?\) 'rparen) | |
706 | (aset table ?\' 'quote) | |
f7359658 RS |
707 | (aset table ?\` 'backquote) |
708 | (aset table ?\, 'comma) | |
1fe3d507 DL |
709 | (aset table ?\" 'string) |
710 | (aset table ?\? 'char) | |
711 | (aset table ?\[ 'lbracket) | |
712 | (aset table ?\] 'rbracket) | |
713 | (aset table ?\. 'dot) | |
714 | (aset table ?\# 'hash) | |
715 | ;; We treat numbers as symbols, because of confusion with -, -1, and 1-. | |
f7359658 | 716 | ;; We don't care about any other chars since they won't be seen. |
1fe3d507 | 717 | table)) |
84fc2cfa | 718 | |
1fe3d507 DL |
719 | (defun edebug-next-token-class () |
720 | ;; Move to the next token and return its class. We only care about | |
f7359658 RS |
721 | ;; lparen, rparen, dot, quote, backquote, comma, string, char, vector, |
722 | ;; or symbol. | |
1fe3d507 | 723 | (edebug-skip-whitespace) |
e4773f39 KH |
724 | (if (and (eq (following-char) ?.) |
725 | (save-excursion | |
726 | (forward-char 1) | |
392cf16d JL |
727 | (or (and (eq (aref edebug-read-syntax-table (following-char)) |
728 | 'symbol) | |
729 | (not (= (following-char) ?\;))) | |
730 | (memq (following-char) '(?\, ?\.))))) | |
e4773f39 KH |
731 | 'symbol |
732 | (aref edebug-read-syntax-table (following-char)))) | |
84fc2cfa | 733 | |
84fc2cfa | 734 | |
1fe3d507 DL |
735 | (defun edebug-skip-whitespace () |
736 | ;; Leave point before the next token, skipping white space and comments. | |
737 | (skip-chars-forward " \t\r\n\f") | |
738 | (while (= (following-char) ?\;) | |
6a6e859a | 739 | (skip-chars-forward "^\n") ; skip the comment |
1fe3d507 | 740 | (skip-chars-forward " \t\r\n\f"))) |
84fc2cfa | 741 | |
84fc2cfa | 742 | |
1fe3d507 | 743 | ;; Mostly obsolete reader; still used in one case. |
84fc2cfa | 744 | |
1fe3d507 DL |
745 | (defun edebug-read-sexp () |
746 | ;; Read one sexp from the current buffer starting at point. | |
747 | ;; Leave point immediately after it. A sexp can be a list or atom. | |
748 | ;; An atom is a symbol (or number), character, string, or vector. | |
749 | ;; This works for reading anything legitimate, but it | |
750 | ;; is gummed up by parser inconsistencies (bugs?) | |
751 | (let ((class (edebug-next-token-class))) | |
752 | (cond | |
753 | ;; read goes one too far if a (possibly quoted) string or symbol | |
754 | ;; is immediately followed by non-whitespace. | |
f4897e40 RS |
755 | ((eq class 'symbol) (edebug-original-read (current-buffer))) |
756 | ((eq class 'string) (edebug-original-read (current-buffer))) | |
1fe3d507 DL |
757 | ((eq class 'quote) (forward-char 1) |
758 | (list 'quote (edebug-read-sexp))) | |
f7359658 RS |
759 | ((eq class 'backquote) |
760 | (list '\` (edebug-read-sexp))) | |
761 | ((eq class 'comma) | |
762 | (list '\, (edebug-read-sexp))) | |
1fe3d507 DL |
763 | (t ; anything else, just read it. |
764 | (edebug-original-read (current-buffer)))))) | |
765 | ||
f7359658 | 766 | ;;; Offsets for reader |
1fe3d507 DL |
767 | |
768 | ;; Define a structure to represent offset positions of expressions. | |
769 | ;; Each offset structure looks like: (before . after) for constituents, | |
770 | ;; or for structures that have elements: (before <subexpressions> . after) | |
771 | ;; where the <subexpressions> are the offset structures for subexpressions | |
772 | ;; including the head of a list. | |
0b936a1e | 773 | (defvar edebug-offsets nil) |
1fe3d507 DL |
774 | |
775 | ;; Stack of offset structures in reverse order of the nesting. | |
776 | ;; This is used to get back to previous levels. | |
0b936a1e SM |
777 | (defvar edebug-offsets-stack nil) |
778 | (defvar edebug-current-offset nil) ; Top of the stack, for convenience. | |
1fe3d507 DL |
779 | |
780 | ;; We must store whether we just read a list with a dotted form that | |
781 | ;; is itself a list. This structure will be condensed, so the offsets | |
782 | ;; must also be condensed. | |
0b936a1e | 783 | (defvar edebug-read-dotted-list nil) |
1fe3d507 DL |
784 | |
785 | (defsubst edebug-initialize-offsets () | |
786 | ;; Reinitialize offset recording. | |
787 | (setq edebug-current-offset nil)) | |
788 | ||
789 | (defun edebug-store-before-offset (point) | |
790 | ;; Add a new offset pair with POINT as the before offset. | |
791 | (let ((new-offset (list point))) | |
792 | (if edebug-current-offset | |
793 | (setcdr edebug-current-offset | |
794 | (cons new-offset (cdr edebug-current-offset))) | |
795 | ;; Otherwise, we are at the top level, so initialize. | |
796 | (setq edebug-offsets new-offset | |
797 | edebug-offsets-stack nil | |
798 | edebug-read-dotted-list nil)) | |
799 | ;; Cons the new offset to the front of the stack. | |
800 | (setq edebug-offsets-stack (cons new-offset edebug-offsets-stack) | |
801 | edebug-current-offset new-offset) | |
84fc2cfa ER |
802 | )) |
803 | ||
1fe3d507 DL |
804 | (defun edebug-store-after-offset (point) |
805 | ;; Finalize the current offset struct by reversing it and | |
806 | ;; store POINT as the after offset. | |
807 | (if (not edebug-read-dotted-list) | |
808 | ;; Just reverse the offsets of all subexpressions. | |
809 | (setcdr edebug-current-offset (nreverse (cdr edebug-current-offset))) | |
810 | ||
811 | ;; We just read a list after a dot, which will be abbreviated out. | |
812 | (setq edebug-read-dotted-list nil) | |
813 | ;; Drop the corresponding offset pair. | |
a1506d29 | 814 | ;; That is, nconc the reverse of the rest of the offsets |
1fe3d507 DL |
815 | ;; with the cdr of last offset. |
816 | (setcdr edebug-current-offset | |
817 | (nconc (nreverse (cdr (cdr edebug-current-offset))) | |
818 | (cdr (car (cdr edebug-current-offset)))))) | |
819 | ||
820 | ;; Now append the point using nconc. | |
821 | (setq edebug-current-offset (nconc edebug-current-offset point)) | |
822 | ;; Pop the stack. | |
823 | (setq edebug-offsets-stack (cdr edebug-offsets-stack) | |
824 | edebug-current-offset (car edebug-offsets-stack))) | |
825 | ||
826 | (defun edebug-ignore-offset () | |
827 | ;; Ignore the last created offset pair. | |
828 | (setcdr edebug-current-offset (cdr (cdr edebug-current-offset)))) | |
829 | ||
1fe3d507 | 830 | (defmacro edebug-storing-offsets (point &rest body) |
5121ef4c | 831 | (declare (debug (form body)) (indent 1)) |
d8f1319a | 832 | `(unwind-protect |
a1506d29 | 833 | (progn |
d8f1319a | 834 | (edebug-store-before-offset ,point) |
a1506d29 | 835 | ,@body) |
d8f1319a | 836 | (edebug-store-after-offset (point)))) |
1fe3d507 DL |
837 | |
838 | ||
f7359658 RS |
839 | ;;; Reader for Emacs Lisp. |
840 | ||
1fe3d507 DL |
841 | ;; Uses edebug-next-token-class (and edebug-skip-whitespace) above. |
842 | ||
843 | (defconst edebug-read-alist | |
844 | '((symbol . edebug-read-symbol) | |
845 | (lparen . edebug-read-list) | |
846 | (string . edebug-read-string) | |
847 | (quote . edebug-read-quote) | |
f7359658 RS |
848 | (backquote . edebug-read-backquote) |
849 | (comma . edebug-read-comma) | |
1fe3d507 DL |
850 | (lbracket . edebug-read-vector) |
851 | (hash . edebug-read-function) | |
852 | )) | |
84fc2cfa | 853 | |
1fe3d507 | 854 | (defun edebug-read-storing-offsets (stream) |
5121ef4c | 855 | (let (edebug-read-dotted-list) ; see edebug-store-after-offset |
1fe3d507 | 856 | (edebug-storing-offsets (point) |
5121ef4c SM |
857 | (funcall |
858 | (or (cdr (assq (edebug-next-token-class) edebug-read-alist)) | |
859 | ;; anything else, just read it. | |
860 | 'edebug-original-read) | |
861 | stream)))) | |
84fc2cfa | 862 | |
1fe3d507 | 863 | (defun edebug-read-symbol (stream) |
f4897e40 | 864 | (edebug-original-read stream)) |
84fc2cfa | 865 | |
1fe3d507 | 866 | (defun edebug-read-string (stream) |
f4897e40 | 867 | (edebug-original-read stream)) |
84fc2cfa | 868 | |
1fe3d507 DL |
869 | (defun edebug-read-quote (stream) |
870 | ;; Turn 'thing into (quote thing) | |
871 | (forward-char 1) | |
872 | (list | |
5121ef4c | 873 | (edebug-storing-offsets (1- (point)) 'quote) |
1fe3d507 DL |
874 | (edebug-read-storing-offsets stream))) |
875 | ||
f7359658 RS |
876 | (defun edebug-read-backquote (stream) |
877 | ;; Turn `thing into (\` thing) | |
5121ef4c SM |
878 | (forward-char 1) |
879 | (list | |
880 | (edebug-storing-offsets (1- (point)) '\`) | |
b1a03ef6 | 881 | (edebug-read-storing-offsets stream))) |
f7359658 RS |
882 | |
883 | (defun edebug-read-comma (stream) | |
884 | ;; Turn ,thing into (\, thing). Handle ,@ and ,. also. | |
885 | (let ((opoint (point))) | |
886 | (forward-char 1) | |
887 | (let ((symbol '\,)) | |
888 | (cond ((eq (following-char) ?\.) | |
889 | (setq symbol '\,\.) | |
890 | (forward-char 1)) | |
891 | ((eq (following-char) ?\@) | |
892 | (setq symbol '\,@) | |
893 | (forward-char 1))) | |
894 | ;; Generate the same structure of offsets we would have | |
895 | ;; if the resulting list appeared verbatim in the input text. | |
b1a03ef6 SM |
896 | (list |
897 | (edebug-storing-offsets opoint symbol) | |
898 | (edebug-read-storing-offsets stream))))) | |
f7359658 | 899 | |
1fe3d507 DL |
900 | (defun edebug-read-function (stream) |
901 | ;; Turn #'thing into (function thing) | |
902 | (forward-char 1) | |
6db746da DL |
903 | (cond ((eq ?\' (following-char)) |
904 | (forward-char 1) | |
a1506d29 | 905 | (list |
a81068ba | 906 | (edebug-storing-offsets (- (point) 2) 'function) |
6db746da | 907 | (edebug-read-storing-offsets stream))) |
057b57f6 | 908 | ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6 |
5121ef4c | 909 | ?7 ?8 ?9 ?0)) |
057b57f6 | 910 | (backward-char 1) |
6db746da DL |
911 | (edebug-original-read stream)) |
912 | (t (edebug-syntax-error "Bad char after #")))) | |
1fe3d507 DL |
913 | |
914 | (defun edebug-read-list (stream) | |
915 | (forward-char 1) ; skip \( | |
a1506d29 | 916 | (prog1 |
1fe3d507 DL |
917 | (let ((elements)) |
918 | (while (not (memq (edebug-next-token-class) '(rparen dot))) | |
b1a03ef6 | 919 | (push (edebug-read-storing-offsets stream) elements)) |
1fe3d507 DL |
920 | (setq elements (nreverse elements)) |
921 | (if (eq 'dot (edebug-next-token-class)) | |
922 | (let (dotted-form) | |
923 | (forward-char 1) ; skip \. | |
924 | (setq dotted-form (edebug-read-storing-offsets stream)) | |
925 | elements (nconc elements dotted-form) | |
926 | (if (not (eq (edebug-next-token-class) 'rparen)) | |
927 | (edebug-syntax-error "Expected `)'")) | |
928 | (setq edebug-read-dotted-list (listp dotted-form)) | |
929 | )) | |
930 | elements) | |
931 | (forward-char 1) ; skip \) | |
932 | )) | |
84fc2cfa | 933 | |
1fe3d507 DL |
934 | (defun edebug-read-vector (stream) |
935 | (forward-char 1) ; skip \[ | |
a1506d29 | 936 | (prog1 |
1fe3d507 DL |
937 | (let ((elements)) |
938 | (while (not (eq 'rbracket (edebug-next-token-class))) | |
5121ef4c | 939 | (push (edebug-read-storing-offsets stream) elements)) |
1fe3d507 DL |
940 | (apply 'vector (nreverse elements))) |
941 | (forward-char 1) ; skip \] | |
84fc2cfa ER |
942 | )) |
943 | ||
f7359658 | 944 | ;;; Cursors for traversal of list and vector elements with offsets. |
1fe3d507 DL |
945 | |
946 | (defvar edebug-dotted-spec nil) | |
947 | ||
948 | (defun edebug-new-cursor (expressions offsets) | |
949 | ;; Return a new cursor for EXPRESSIONS with OFFSETS. | |
a1506d29 | 950 | (if (vectorp expressions) |
1fe3d507 DL |
951 | (setq expressions (append expressions nil))) |
952 | (cons expressions offsets)) | |
953 | ||
954 | (defsubst edebug-set-cursor (cursor expressions offsets) | |
955 | ;; Set the CURSOR's EXPRESSIONS and OFFSETS to the given. | |
956 | ;; Return the cursor. | |
957 | (setcar cursor expressions) | |
958 | (setcdr cursor offsets) | |
959 | cursor) | |
960 | ||
552754fe | 961 | (defun edebug-copy-cursor (cursor) |
1fe3d507 DL |
962 | ;; Copy the cursor using the same object and offsets. |
963 | (cons (car cursor) (cdr cursor))) | |
964 | ||
965 | (defsubst edebug-cursor-expressions (cursor) | |
966 | (car cursor)) | |
967 | (defsubst edebug-cursor-offsets (cursor) | |
968 | (cdr cursor)) | |
969 | ||
970 | (defsubst edebug-empty-cursor (cursor) | |
971 | ;; Return non-nil if CURSOR is empty - meaning no more elements. | |
972 | (null (car cursor))) | |
973 | ||
974 | (defsubst edebug-top-element (cursor) | |
975 | ;; Return the top element at the cursor. | |
976 | ;; Assumes not empty. | |
977 | (car (car cursor))) | |
978 | ||
979 | (defun edebug-top-element-required (cursor &rest error) | |
980 | ;; Check if a dotted form is required. | |
981 | (if edebug-dotted-spec (edebug-no-match cursor "Dot expected.")) | |
982 | ;; Check if there is at least one more argument. | |
983 | (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error)) | |
984 | ;; Return that top element. | |
985 | (edebug-top-element cursor)) | |
986 | ||
987 | (defsubst edebug-top-offset (cursor) | |
988 | ;; Return the top offset pair corresponding to the top element. | |
989 | (car (cdr cursor))) | |
990 | ||
991 | (defun edebug-move-cursor (cursor) | |
992 | ;; Advance and return the cursor to the next element and offset. | |
993 | ;; throw no-match if empty before moving. | |
994 | ;; This is a violation of the cursor encapsulation, but | |
995 | ;; there is plenty of that going on while matching. | |
996 | ;; The following test should always fail. | |
a1506d29 | 997 | (if (edebug-empty-cursor cursor) |
1fe3d507 DL |
998 | (edebug-no-match cursor "Not enough arguments.")) |
999 | (setcar cursor (cdr (car cursor))) | |
1000 | (setcdr cursor (cdr (cdr cursor))) | |
1001 | cursor) | |
1002 | ||
1003 | ||
1004 | (defun edebug-before-offset (cursor) | |
1005 | ;; Return the before offset of the cursor. | |
1006 | ;; If there is nothing left in the offsets, | |
a1506d29 | 1007 | ;; return one less than the offset itself, |
1fe3d507 DL |
1008 | ;; which is the after offset for a list. |
1009 | (let ((offset (edebug-cursor-offsets cursor))) | |
1010 | (if (consp offset) | |
1011 | (car (car offset)) | |
1012 | (1- offset)))) | |
1013 | ||
1014 | (defun edebug-after-offset (cursor) | |
1015 | ;; Return the after offset of the cursor object. | |
1016 | (let ((offset (edebug-top-offset cursor))) | |
1017 | (while (consp offset) | |
1018 | (setq offset (cdr offset))) | |
1019 | offset)) | |
1020 | ||
f7359658 | 1021 | ;;; The Parser |
1fe3d507 | 1022 | |
f7359658 RS |
1023 | ;; The top level function for parsing forms is |
1024 | ;; edebug-read-and-maybe-wrap-form; it calls all the rest. It checks the | |
1025 | ;; syntax a bit and leaves point at any error it finds, but otherwise | |
1026 | ;; should appear to work like eval-defun. | |
1fe3d507 | 1027 | |
f7359658 RS |
1028 | ;; The basic plan is to surround each expression with a call to |
1029 | ;; the edebug debugger together with indexes into a table of positions of | |
1030 | ;; all expressions. Thus an expression "exp" becomes: | |
1fe3d507 | 1031 | |
f7359658 | 1032 | ;; (edebug-after (edebug-before 1) 2 exp) |
1fe3d507 | 1033 | |
f7359658 RS |
1034 | ;; When this is evaluated, first point is moved to the beginning of |
1035 | ;; exp at offset 1 of the current function. The expression is | |
1036 | ;; evaluated, which may cause more edebug calls, and then point is | |
1037 | ;; moved to offset 2 after the end of exp. | |
1fe3d507 | 1038 | |
f7359658 RS |
1039 | ;; The highest level expressions of the function are wrapped in a call to |
1040 | ;; edebug-enter, which supplies the function name and the actual | |
1041 | ;; arguments to the function. See functions edebug-enter, edebug-before, | |
1042 | ;; and edebug-after for more details. | |
1fe3d507 DL |
1043 | |
1044 | ;; Dynamically bound vars, left unbound, but globally declared. | |
1045 | ;; This is to quiet the byte compiler. | |
1046 | ||
1047 | ;; Window data of the highest definition being wrapped. | |
1048 | ;; This data is shared by all embedded definitions. | |
1049 | (defvar edebug-top-window-data) | |
1050 | ||
1051 | (defvar edebug-&optional) | |
1052 | (defvar edebug-&rest) | |
1053 | (defvar edebug-gate nil) ;; whether no-match forces an error. | |
1054 | ||
0b936a1e SM |
1055 | (defvar edebug-def-name nil) ; name of definition, used by interactive-form |
1056 | (defvar edebug-old-def-name nil) ; previous name of containing definition. | |
1fe3d507 | 1057 | |
0b936a1e SM |
1058 | (defvar edebug-error-point nil) |
1059 | (defvar edebug-best-error nil) | |
1fe3d507 DL |
1060 | |
1061 | ||
1062 | (defun edebug-read-and-maybe-wrap-form () | |
1063 | ;; Read a form and wrap it with edebug calls, if the conditions are right. | |
1064 | ;; Here we just catch any no-match not caught below and signal an error. | |
1065 | ||
1066 | ;; Run the setup hook. | |
88b52bf5 RS |
1067 | ;; If it gets an error, make it nil. |
1068 | (let ((temp-hook edebug-setup-hook)) | |
1069 | (setq edebug-setup-hook nil) | |
bd8d6108 SM |
1070 | (if (functionp temp-hook) (funcall temp-hook) |
1071 | (mapc #'funcall temp-hook))) | |
1fe3d507 DL |
1072 | |
1073 | (let (result | |
1074 | edebug-top-window-data | |
1075 | edebug-def-name;; make sure it is locally nil | |
f7359658 | 1076 | ;; I don't like these here!! |
1fe3d507 DL |
1077 | edebug-&optional |
1078 | edebug-&rest | |
1079 | edebug-gate | |
1080 | edebug-best-error | |
1081 | edebug-error-point | |
1082 | no-match | |
1083 | ;; Do this once here instead of several times. | |
1084 | (max-lisp-eval-depth (+ 800 max-lisp-eval-depth)) | |
f7359658 | 1085 | (max-specpdl-size (+ 2000 max-specpdl-size))) |
1fe3d507 DL |
1086 | (setq no-match |
1087 | (catch 'no-match | |
1088 | (setq result (edebug-read-and-maybe-wrap-form1)) | |
1089 | nil)) | |
1090 | (if no-match | |
1091 | (apply 'edebug-syntax-error no-match)) | |
1092 | result)) | |
1093 | ||
1094 | ||
1095 | (defun edebug-read-and-maybe-wrap-form1 () | |
1096 | (let (spec | |
1097 | def-kind | |
1098 | defining-form-p | |
1099 | def-name | |
f7359658 | 1100 | ;; These offset things don't belong here, but to support recursive |
1fe3d507 DL |
1101 | ;; calls to edebug-read, they need to be here. |
1102 | edebug-offsets | |
1103 | edebug-offsets-stack | |
1104 | edebug-current-offset ; reset to nil | |
1105 | ) | |
1106 | (save-excursion | |
1107 | (if (and (eq 'lparen (edebug-next-token-class)) | |
1108 | (eq 'symbol (progn (forward-char 1) (edebug-next-token-class)))) | |
1109 | ;; Find out if this is a defining form from first symbol | |
88668147 | 1110 | (setq def-kind (edebug-original-read (current-buffer)) |
1fe3d507 DL |
1111 | spec (and (symbolp def-kind) (get-edebug-spec def-kind)) |
1112 | defining-form-p (and (listp spec) | |
1113 | (eq '&define (car spec))) | |
1114 | ;; This is incorrect in general!! But OK most of the time. | |
a1506d29 | 1115 | def-name (if (and defining-form-p |
1fe3d507 DL |
1116 | (eq 'name (car (cdr spec))) |
1117 | (eq 'symbol (edebug-next-token-class))) | |
88668147 DL |
1118 | (edebug-original-read (current-buffer)))))) |
1119 | ;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms) | |
84fc2cfa | 1120 | (cond |
1fe3d507 DL |
1121 | (defining-form-p |
1122 | (if (or edebug-all-defs edebug-all-forms) | |
1123 | ;; If it is a defining form and we are edebugging defs, | |
1124 | ;; then let edebug-list-form start it. | |
a1506d29 | 1125 | (let ((cursor (edebug-new-cursor |
1fe3d507 DL |
1126 | (list (edebug-read-storing-offsets (current-buffer))) |
1127 | (list edebug-offsets)))) | |
1128 | (car | |
1129 | (edebug-make-form-wrapper | |
1130 | cursor | |
a1506d29 | 1131 | (edebug-before-offset cursor) |
1fe3d507 DL |
1132 | (1- (edebug-after-offset cursor)) |
1133 | (list (cons (symbol-name def-kind) (cdr spec)))))) | |
1134 | ||
1135 | ;; Not edebugging this form, so reset the symbol's edebug | |
1136 | ;; property to be just a marker at the definition's source code. | |
1137 | ;; This only works for defs with simple names. | |
1138 | (put def-name 'edebug (point-marker)) | |
1139 | ;; Also nil out dependent defs. | |
a1506d29 | 1140 | '(mapcar (function |
1fe3d507 DL |
1141 | (lambda (def) |
1142 | (put def-name 'edebug nil))) | |
1143 | (get def-name 'edebug-dependents)) | |
1144 | (edebug-read-sexp))) | |
1145 | ||
1146 | ;; If all forms are being edebugged, explicitly wrap it. | |
1147 | (edebug-all-forms | |
a1506d29 | 1148 | (let ((cursor (edebug-new-cursor |
1fe3d507 DL |
1149 | (list (edebug-read-storing-offsets (current-buffer))) |
1150 | (list edebug-offsets)))) | |
a1506d29 | 1151 | (edebug-make-form-wrapper |
1fe3d507 | 1152 | cursor |
a1506d29 JB |
1153 | (edebug-before-offset cursor) |
1154 | (edebug-after-offset cursor) | |
1fe3d507 DL |
1155 | nil))) |
1156 | ||
1157 | ;; Not a defining form, and not edebugging. | |
1158 | (t (edebug-read-sexp))) | |
1159 | )) | |
1160 | ||
1161 | ||
1162 | (defvar edebug-def-args) ; args of defining form. | |
1163 | (defvar edebug-def-interactive) ; is it an emacs interactive function? | |
1164 | (defvar edebug-inside-func) ;; whether code is inside function context. | |
1165 | ;; Currently def-form sets this to nil; def-body sets it to t. | |
1166 | ||
1167 | (defun edebug-interactive-p-name () | |
1168 | ;; Return a unique symbol for the variable used to store the | |
1169 | ;; status of interactive-p for this function. | |
1170 | (intern (format "edebug-%s-interactive-p" edebug-def-name))) | |
1171 | ||
1172 | ||
1173 | (defun edebug-wrap-def-body (forms) | |
1174 | "Wrap the FORMS of a definition body." | |
1175 | (if edebug-def-interactive | |
d8f1319a GM |
1176 | `(let ((,(edebug-interactive-p-name) |
1177 | (interactive-p))) | |
1178 | ,(edebug-make-enter-wrapper forms)) | |
1fe3d507 DL |
1179 | (edebug-make-enter-wrapper forms))) |
1180 | ||
1181 | ||
1182 | (defun edebug-make-enter-wrapper (forms) | |
1183 | ;; Generate the enter wrapper for some forms of a definition. | |
1184 | ;; This is not to be used for the body of other forms, e.g. `while', | |
1185 | ;; since it wraps the list of forms with a call to `edebug-enter'. | |
1186 | ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. | |
1187 | ;; Do this after parsing since that may find a name. | |
a1506d29 | 1188 | (setq edebug-def-name |
f7359658 | 1189 | (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) |
d8f1319a GM |
1190 | `(edebug-enter |
1191 | (quote ,edebug-def-name) | |
a1506d29 | 1192 | ,(if edebug-inside-func |
ebb4159c GM |
1193 | `(list |
1194 | ;; Doesn't work with more than one def-body!! | |
1195 | ;; But the list will just be reversed. | |
1196 | ,@(nreverse edebug-def-args)) | |
d8f1319a GM |
1197 | 'nil) |
1198 | (function (lambda () ,@forms)) | |
1199 | )) | |
1fe3d507 DL |
1200 | |
1201 | ||
1202 | (defvar edebug-form-begin-marker) ; the mark for def being instrumented | |
a1506d29 | 1203 | |
1fe3d507 DL |
1204 | (defvar edebug-offset-index) ; the next available offset index. |
1205 | (defvar edebug-offset-list) ; the list of offset positions. | |
1206 | ||
1207 | (defun edebug-inc-offset (offset) | |
bd8d6108 SM |
1208 | ;; Modifies edebug-offset-index and edebug-offset-list |
1209 | ;; accesses edebug-func-marc and buffer point. | |
1fe3d507 DL |
1210 | (prog1 |
1211 | edebug-offset-index | |
1212 | (setq edebug-offset-list (cons (- offset edebug-form-begin-marker) | |
1213 | edebug-offset-list) | |
1214 | edebug-offset-index (1+ edebug-offset-index)))) | |
1215 | ||
1216 | ||
1217 | (defun edebug-make-before-and-after-form (before-index form after-index) | |
1218 | ;; Return the edebug form for the current function at offset BEFORE-INDEX | |
a1506d29 | 1219 | ;; given FORM. Looks like: |
1fe3d507 DL |
1220 | ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM) |
1221 | ;; Also increment the offset index for subsequent use. | |
bd8d6108 | 1222 | `(edebug-after (edebug-before ,before-index) ,after-index ,form)) |
1fe3d507 DL |
1223 | |
1224 | (defun edebug-make-after-form (form after-index) | |
1225 | ;; Like edebug-make-before-and-after-form, but only after. | |
bd8d6108 | 1226 | `(edebug-after 0 ,after-index ,form)) |
1fe3d507 DL |
1227 | |
1228 | ||
1229 | (defun edebug-unwrap (sexp) | |
1230 | "Return the unwrapped SEXP or return it as is if it is not wrapped. | |
a1506d29 | 1231 | The SEXP might be the result of wrapping a body, which is a list of |
1fe3d507 DL |
1232 | expressions; a `progn' form will be returned enclosing these forms." |
1233 | (if (consp sexp) | |
a1506d29 | 1234 | (cond |
1fe3d507 DL |
1235 | ((eq 'edebug-after (car sexp)) |
1236 | (nth 3 sexp)) | |
1237 | ((eq 'edebug-enter (car sexp)) | |
4dd1c416 | 1238 | (macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp))))) |
1fe3d507 DL |
1239 | (t sexp);; otherwise it is not wrapped, so just return it. |
1240 | ) | |
1241 | sexp)) | |
1242 | ||
1243 | (defun edebug-unwrap* (sexp) | |
242b1f68 | 1244 | "Return the SEXP recursively unwrapped." |
1fe3d507 DL |
1245 | (let ((new-sexp (edebug-unwrap sexp))) |
1246 | (while (not (eq sexp new-sexp)) | |
1247 | (setq sexp new-sexp | |
1248 | new-sexp (edebug-unwrap sexp))) | |
1249 | (if (consp new-sexp) | |
1250 | (mapcar 'edebug-unwrap* new-sexp) | |
1251 | new-sexp))) | |
1252 | ||
1253 | ||
1254 | (defun edebug-defining-form (cursor form-begin form-end speclist) | |
1255 | ;; Process the defining form, starting outside the form. | |
1256 | ;; The speclist is a generated list spec that looks like: | |
1257 | ;; (("def-symbol" defining-form-spec-sans-&define)) | |
1258 | ;; Skip the first offset. | |
1259 | (edebug-set-cursor cursor (edebug-cursor-expressions cursor) | |
1260 | (cdr (edebug-cursor-offsets cursor))) | |
a1506d29 JB |
1261 | (edebug-make-form-wrapper |
1262 | cursor | |
1fe3d507 DL |
1263 | form-begin (1- form-end) |
1264 | speclist)) | |
1265 | ||
1266 | (defun edebug-make-form-wrapper (cursor form-begin form-end | |
1267 | &optional speclist) | |
1268 | ;; Wrap a form, usually a defining form, but any evaluated one. | |
1269 | ;; If speclist is non-nil, this is being called by edebug-defining-form. | |
1270 | ;; Otherwise it is being called from edebug-read-and-maybe-wrap-form1. | |
3ed8598c | 1271 | ;; This is a hack, but I haven't figured out a simpler way yet. |
1fe3d507 DL |
1272 | (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end)) |
1273 | ;; Set this marker before parsing. | |
a1506d29 JB |
1274 | (edebug-form-begin-marker |
1275 | (if form-data-entry | |
2de39f08 | 1276 | (edebug--form-data-begin form-data-entry) |
1fe3d507 DL |
1277 | ;; Buffer must be current-buffer for this to work: |
1278 | (set-marker (make-marker) form-begin)))) | |
1279 | ||
1280 | (let (edebug-offset-list | |
1281 | (edebug-offset-index 0) | |
1282 | result | |
1283 | ;; For definitions. | |
1284 | ;; (edebug-containing-def-name edebug-def-name) | |
1285 | ;; Get name from form-data, if any. | |
2de39f08 | 1286 | (edebug-old-def-name (edebug--form-data-name form-data-entry)) |
1fe3d507 DL |
1287 | edebug-def-name |
1288 | edebug-def-args | |
1289 | edebug-def-interactive | |
1290 | edebug-inside-func;; whether wrapped code executes inside a function. | |
1291 | ) | |
a1506d29 | 1292 | |
1fe3d507 DL |
1293 | (setq result |
1294 | (if speclist | |
1295 | (edebug-match cursor speclist) | |
1296 | ||
1297 | ;; else wrap as an enter-form. | |
1298 | (edebug-make-enter-wrapper (list (edebug-form cursor))))) | |
a1506d29 | 1299 | |
1fe3d507 | 1300 | ;; Set the name here if it was not set by edebug-make-enter-wrapper. |
a1506d29 | 1301 | (setq edebug-def-name |
f7359658 | 1302 | (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) |
1fe3d507 DL |
1303 | |
1304 | ;; Add this def as a dependent of containing def. Buggy. | |
1305 | '(if (and edebug-containing-def-name | |
1306 | (not (get edebug-containing-def-name 'edebug-dependents))) | |
1307 | (put edebug-containing-def-name 'edebug-dependents | |
a1506d29 JB |
1308 | (cons edebug-def-name |
1309 | (get edebug-containing-def-name | |
1fe3d507 DL |
1310 | 'edebug-dependents)))) |
1311 | ||
1312 | ;; Create a form-data-entry or modify existing entry's markers. | |
1313 | ;; In the latter case, pointers to the entry remain eq. | |
1314 | (if (not form-data-entry) | |
a1506d29 | 1315 | (setq form-data-entry |
2de39f08 | 1316 | (edebug--make-form-data-entry |
a1506d29 | 1317 | edebug-def-name |
1fe3d507 DL |
1318 | edebug-form-begin-marker |
1319 | ;; Buffer must be current-buffer. | |
1320 | (set-marker (make-marker) form-end) | |
1321 | )) | |
a1506d29 | 1322 | (edebug-set-form-data-entry |
1fe3d507 DL |
1323 | form-data-entry edebug-def-name ;; in case name is changed |
1324 | form-begin form-end)) | |
1325 | ||
1326 | ;; (message "defining: %s" edebug-def-name) (sit-for 2) | |
1327 | (edebug-make-top-form-data-entry form-data-entry) | |
1328 | (message "Edebug: %s" edebug-def-name) | |
1329 | ;;(debug edebug-def-name) | |
1330 | ||
1331 | ;; Destructively reverse edebug-offset-list and make vector from it. | |
1332 | (setq edebug-offset-list (vconcat (nreverse edebug-offset-list))) | |
1333 | ||
1334 | ;; Side effects on the property list of edebug-def-name. | |
1335 | (edebug-clear-frequency-count edebug-def-name) | |
1336 | (edebug-clear-coverage edebug-def-name) | |
1337 | ||
1338 | ;; Set up the initial window data. | |
1339 | (if (not edebug-top-window-data) ;; if not already set, do it now. | |
1340 | (let ((window ;; Find the best window for this buffer. | |
1341 | (or (get-buffer-window (current-buffer)) | |
1342 | (selected-window)))) | |
a1506d29 | 1343 | (setq edebug-top-window-data |
1fe3d507 DL |
1344 | (cons window (window-start window))))) |
1345 | ||
1346 | ;; Store the edebug data in symbol's property list. | |
1347 | (put edebug-def-name 'edebug | |
1348 | ;; A struct or vector would be better here!! | |
1349 | (list edebug-form-begin-marker | |
1350 | nil ; clear breakpoints | |
1351 | edebug-offset-list | |
1352 | edebug-top-window-data | |
1353 | )) | |
1354 | result | |
84fc2cfa ER |
1355 | ))) |
1356 | ||
1357 | ||
1fe3d507 DL |
1358 | (defun edebug-clear-frequency-count (name) |
1359 | ;; Create initial frequency count vector. | |
1360 | ;; For each stop point, the counter is incremented each time it is visited. | |
1361 | (put name 'edebug-freq-count | |
1362 | (make-vector (length edebug-offset-list) 0))) | |
1363 | ||
1364 | ||
1365 | (defun edebug-clear-coverage (name) | |
a1506d29 | 1366 | ;; Create initial coverage vector. |
1fe3d507 | 1367 | ;; Only need one per expression, but it is simpler to use stop points. |
a1506d29 | 1368 | (put name 'edebug-coverage |
1fe3d507 | 1369 | (make-vector (length edebug-offset-list) 'unknown))) |
84fc2cfa | 1370 | |
84fc2cfa | 1371 | |
1fe3d507 | 1372 | (defun edebug-form (cursor) |
a1506d29 | 1373 | ;; Return the instrumented form for the following form. |
1fe3d507 DL |
1374 | ;; Add the point offsets to the edebug-offset-list for the form. |
1375 | (let* ((form (edebug-top-element-required cursor "Expected form")) | |
1376 | (offset (edebug-top-offset cursor))) | |
1377 | (prog1 | |
84fc2cfa | 1378 | (cond |
1fe3d507 DL |
1379 | ((consp form) |
1380 | ;; The first offset for a list form is for the list form itself. | |
1381 | (if (eq 'quote (car form)) | |
1382 | form | |
1383 | (let* ((head (car form)) | |
1384 | (spec (and (symbolp head) (get-edebug-spec head))) | |
1385 | (new-cursor (edebug-new-cursor form offset))) | |
1386 | ;; Find out if this is a defining form from first symbol. | |
1387 | ;; An indirect spec would not work here, yet. | |
1388 | (if (and (consp spec) (eq '&define (car spec))) | |
a1506d29 JB |
1389 | (edebug-defining-form |
1390 | new-cursor | |
1fe3d507 | 1391 | (car offset);; before the form |
a1506d29 | 1392 | (edebug-after-offset cursor) |
1fe3d507 DL |
1393 | (cons (symbol-name head) (cdr spec))) |
1394 | ;; Wrap a regular form. | |
a1506d29 | 1395 | (edebug-make-before-and-after-form |
1fe3d507 DL |
1396 | (edebug-inc-offset (car offset)) |
1397 | (edebug-list-form new-cursor) | |
1398 | ;; After processing the list form, the new-cursor is left | |
1399 | ;; with the offset after the form. | |
1400 | (edebug-inc-offset (edebug-cursor-offsets new-cursor)))) | |
1401 | ))) | |
1402 | ||
1403 | ((symbolp form) | |
1404 | (cond | |
f7359658 | 1405 | ;; Check for constant symbols that don't get wrapped. |
1fe3d507 | 1406 | ((or (memq form '(t nil)) |
be0dd657 | 1407 | (keywordp form)) |
1fe3d507 DL |
1408 | form) |
1409 | ||
1fe3d507 DL |
1410 | (t ;; just a variable |
1411 | (edebug-make-after-form form (edebug-inc-offset (cdr offset)))))) | |
1412 | ||
1413 | ;; Anything else is self-evaluating. | |
1414 | (t form)) | |
1415 | (edebug-move-cursor cursor)))) | |
1416 | ||
1417 | ||
1418 | (defsubst edebug-forms (cursor) (edebug-match cursor '(&rest form))) | |
1419 | (defsubst edebug-sexps (cursor) (edebug-match cursor '(&rest sexp))) | |
1420 | ||
1421 | (defsubst edebug-list-form-args (head cursor) | |
1422 | ;; Process the arguments of a list form given that head of form is a symbol. | |
1423 | ;; Helper for edebug-list-form | |
1424 | (let ((spec (get-edebug-spec head))) | |
1425 | (cond | |
1426 | (spec | |
1427 | (cond | |
1428 | ((consp spec) | |
1429 | ;; It is a speclist. | |
1430 | (let (edebug-best-error | |
1431 | edebug-error-point);; This may not be needed. | |
1432 | (edebug-match-sublist cursor spec))) | |
1433 | ((eq t spec) (edebug-forms cursor)) | |
1434 | ((eq 0 spec) (edebug-sexps cursor)) | |
1435 | ((symbolp spec) (funcall spec cursor));; Not used by edebug, | |
1436 | ; but leave it in for compatibility. | |
1437 | )) | |
1438 | ;; No edebug-form-spec provided. | |
1439 | ((edebug-macrop head) | |
1440 | (if edebug-eval-macro-args | |
1441 | (edebug-forms cursor) | |
1442 | (edebug-sexps cursor))) | |
1443 | (t ;; Otherwise it is a function call. | |
1444 | (edebug-forms cursor))))) | |
1445 | ||
1446 | ||
1447 | (defun edebug-list-form (cursor) | |
1448 | ;; Return an instrumented form built from the list form. | |
1449 | ;; The after offset will be left in the cursor after processing the form. | |
1450 | (let ((head (edebug-top-element-required cursor "Expected elements")) | |
1451 | ;; Prevent backtracking whenever instrumenting. | |
1452 | (edebug-gate t) | |
1453 | ;; A list form is never optional because it matches anything. | |
1454 | (edebug-&optional nil) | |
1455 | (edebug-&rest nil)) | |
1456 | ;; Skip the first offset. | |
1457 | (edebug-set-cursor cursor (edebug-cursor-expressions cursor) | |
1458 | (cdr (edebug-cursor-offsets cursor))) | |
1459 | (cond | |
1fe3d507 DL |
1460 | ((symbolp head) |
1461 | (cond | |
f4c4910c | 1462 | ((null head) nil) ; () is valid. |
1fe3d507 DL |
1463 | ((eq head 'interactive-p) |
1464 | ;; Special case: replace (interactive-p) with variable | |
1465 | (setq edebug-def-interactive 'check-it) | |
1466 | (edebug-move-cursor cursor) | |
1467 | (edebug-interactive-p-name)) | |
1468 | (t | |
a1506d29 | 1469 | (cons head (edebug-list-form-args |
1fe3d507 DL |
1470 | head (edebug-move-cursor cursor)))))) |
1471 | ||
1472 | ((consp head) | |
2fa9dc2f | 1473 | (if (eq (car head) '\,) |
d778509c SM |
1474 | ;; The head of a form should normally be a symbol or a lambda |
1475 | ;; expression but it can also be an unquote form to be filled | |
1476 | ;; before evaluation. We evaluate the arguments anyway, on the | |
1477 | ;; assumption that the unquote form will place a proper function | |
1478 | ;; name (rather than a macro name). | |
1fe3d507 DL |
1479 | (edebug-match cursor '(("," def-form) body)) |
1480 | ;; Process anonymous function and args. | |
1481 | ;; This assumes no anonymous macros. | |
1482 | (edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs))) | |
1483 | ||
1484 | (t (edebug-syntax-error | |
d778509c | 1485 | "Head of list form must be a symbol or lambda expression"))) |
1fe3d507 DL |
1486 | )) |
1487 | ||
f7359658 | 1488 | ;;; Matching of specs. |
1fe3d507 DL |
1489 | |
1490 | (defvar edebug-after-dotted-spec nil) | |
1491 | ||
1492 | (defvar edebug-matching-depth 0) ;; initial value | |
1493 | (defconst edebug-max-depth 150) ;; maximum number of matching recursions. | |
1494 | ||
1495 | ||
a1506d29 | 1496 | ;;; Failure to match |
f7359658 | 1497 | |
1fe3d507 DL |
1498 | ;; This throws to no-match, if there are higher alternatives. |
1499 | ;; Otherwise it signals an error. The place of the error is found | |
1500 | ;; with the two before- and after-offset functions. | |
1501 | ||
bd8d6108 | 1502 | (defun edebug-no-match (cursor &rest args) |
1fe3d507 DL |
1503 | ;; Throw a no-match, or signal an error immediately if gate is active. |
1504 | ;; Remember this point in case we need to report this error. | |
1505 | (setq edebug-error-point (or edebug-error-point | |
1506 | (edebug-before-offset cursor)) | |
bd8d6108 | 1507 | edebug-best-error (or edebug-best-error args)) |
1fe3d507 DL |
1508 | (if (and edebug-gate (not edebug-&optional)) |
1509 | (progn | |
1510 | (if edebug-error-point | |
1511 | (goto-char edebug-error-point)) | |
bd8d6108 | 1512 | (apply 'edebug-syntax-error args)) |
2de39f08 | 1513 | (throw 'no-match args))) |
1fe3d507 DL |
1514 | |
1515 | ||
1516 | (defun edebug-match (cursor specs) | |
1517 | ;; Top level spec matching function. | |
1518 | ;; Used also at each lower level of specs. | |
1519 | (let (edebug-&optional | |
1520 | edebug-&rest | |
1521 | edebug-best-error | |
1522 | edebug-error-point | |
1523 | (edebug-gate edebug-gate) ;; locally bound to limit effect | |
1524 | ) | |
1525 | (edebug-match-specs cursor specs 'edebug-match-specs))) | |
1526 | ||
1527 | ||
1528 | (defun edebug-match-one-spec (cursor spec) | |
1529 | ;; Match one spec, which is not a keyword &-spec. | |
1530 | (cond | |
1531 | ((symbolp spec) (edebug-match-symbol cursor spec)) | |
1532 | ((vectorp spec) (edebug-match cursor (append spec nil))) | |
1533 | ((stringp spec) (edebug-match-string cursor spec)) | |
1534 | ((listp spec) (edebug-match-list cursor spec)) | |
1535 | )) | |
1536 | ||
1537 | ||
1538 | (defun edebug-match-specs (cursor specs remainder-handler) | |
1539 | ;; Append results of matching the list of specs. | |
1540 | ;; The first spec is handled and the remainder-handler handles the rest. | |
a1506d29 | 1541 | (let ((edebug-matching-depth |
1fe3d507 | 1542 | (if (> edebug-matching-depth edebug-max-depth) |
9854542e | 1543 | (error "Too deep - perhaps infinite loop in spec?") |
1fe3d507 DL |
1544 | (1+ edebug-matching-depth)))) |
1545 | (cond | |
1546 | ((null specs) nil) | |
a1506d29 | 1547 | |
1fe3d507 | 1548 | ;; Is the spec dotted? |
a1506d29 | 1549 | ((atom specs) |
1fe3d507 DL |
1550 | (let ((edebug-dotted-spec t));; Containing spec list was dotted. |
1551 | (edebug-match-specs cursor (list specs) remainder-handler))) | |
1552 | ||
1553 | ;; Is the form dotted? | |
1554 | ((not (listp (edebug-cursor-expressions cursor)));; allow nil | |
1555 | (if (not edebug-dotted-spec) | |
1556 | (edebug-no-match cursor "Dotted spec required.")) | |
1557 | ;; Cancel dotted spec and dotted form. | |
1558 | (let ((edebug-dotted-spec) | |
1559 | (this-form (edebug-cursor-expressions cursor)) | |
1560 | (this-offset (edebug-cursor-offsets cursor))) | |
1561 | ;; Wrap the form in a list, (by changing the cursor??)... | |
1562 | (edebug-set-cursor cursor (list this-form) this-offset) | |
1563 | ;; and process normally, then unwrap the result. | |
1564 | (car (edebug-match-specs cursor specs remainder-handler)))) | |
1565 | ||
1566 | (t;; Process normally. | |
1567 | (let* ((spec (car specs)) | |
a1506d29 | 1568 | (rest) |
1fe3d507 DL |
1569 | (first-char (and (symbolp spec) (aref (symbol-name spec) 0)))) |
1570 | ;;(message "spec = %s first char = %s" spec first-char) (sit-for 1) | |
1571 | (nconc | |
1572 | (cond | |
1573 | ((eq ?& first-char);; "&" symbols take all following specs. | |
1574 | (funcall (get-edebug-spec spec) cursor (cdr specs))) | |
1575 | ((eq ?: first-char);; ":" symbols take one following spec. | |
1576 | (setq rest (cdr (cdr specs))) | |
1577 | (funcall (get-edebug-spec spec) cursor (car (cdr specs)))) | |
1578 | (t;; Any other normal spec. | |
1579 | (setq rest (cdr specs)) | |
1580 | (edebug-match-one-spec cursor spec))) | |
1581 | (funcall remainder-handler cursor rest remainder-handler))))))) | |
1582 | ||
1583 | ||
1584 | ;; Define specs for all the symbol specs with functions used to process them. | |
f7359658 | 1585 | ;; Perhaps we shouldn't be doing this with edebug-form-specs since the |
1fe3d507 DL |
1586 | ;; user may want to define macros or functions with the same names. |
1587 | ;; We could use an internal obarray for these primitive specs. | |
1588 | ||
f71974e1 SM |
1589 | (dolist (pair '((&optional . edebug-match-&optional) |
1590 | (&rest . edebug-match-&rest) | |
1591 | (&or . edebug-match-&or) | |
1592 | (form . edebug-match-form) | |
1593 | (sexp . edebug-match-sexp) | |
1594 | (body . edebug-match-body) | |
1595 | (&define . edebug-match-&define) | |
1596 | (name . edebug-match-name) | |
1597 | (:name . edebug-match-colon-name) | |
1598 | (arg . edebug-match-arg) | |
1599 | (def-body . edebug-match-def-body) | |
1600 | (def-form . edebug-match-def-form) | |
1601 | ;; Less frequently used: | |
1602 | ;; (function . edebug-match-function) | |
1603 | (lambda-expr . edebug-match-lambda-expr) | |
1604 | (¬ . edebug-match-¬) | |
1605 | (&key . edebug-match-&key) | |
1606 | (place . edebug-match-place) | |
1607 | (gate . edebug-match-gate) | |
1608 | ;; (nil . edebug-match-nil) not this one - special case it. | |
1609 | )) | |
1610 | (put (car pair) 'edebug-form-spec (cdr pair))) | |
1fe3d507 DL |
1611 | |
1612 | (defun edebug-match-symbol (cursor symbol) | |
1613 | ;; Match a symbol spec. | |
1614 | (let* ((spec (get-edebug-spec symbol))) | |
1615 | (cond | |
a1506d29 | 1616 | (spec |
1fe3d507 DL |
1617 | (if (consp spec) |
1618 | ;; It is an indirect spec. | |
1619 | (edebug-match cursor spec) | |
1620 | ;; Otherwise it should be the symbol name of a function. | |
1621 | ;; There could be a bug here - maybe need to do edebug-match bindings. | |
1622 | (funcall spec cursor))) | |
a1506d29 | 1623 | |
1fe3d507 DL |
1624 | ((null symbol) ;; special case this. |
1625 | (edebug-match-nil cursor)) | |
1626 | ||
a1506d29 | 1627 | ((fboundp symbol) ; is it a predicate? |
1fe3d507 DL |
1628 | (let ((sexp (edebug-top-element-required cursor "Expected" symbol))) |
1629 | ;; Special case for edebug-`. | |
2fa9dc2f | 1630 | (if (and (listp sexp) (eq (car sexp) '\,)) |
1fe3d507 DL |
1631 | (edebug-match cursor '(("," def-form))) |
1632 | (if (not (funcall symbol sexp)) | |
1633 | (edebug-no-match cursor symbol "failed")) | |
1634 | (edebug-move-cursor cursor) | |
1635 | (list sexp)))) | |
1636 | (t (error "%s is not a form-spec or function" symbol)) | |
1637 | ))) | |
1638 | ||
1639 | ||
1640 | (defun edebug-match-sexp (cursor) | |
1641 | (list (prog1 (edebug-top-element-required cursor "Expected sexp") | |
1642 | (edebug-move-cursor cursor)))) | |
1643 | ||
1644 | (defun edebug-match-form (cursor) | |
1645 | (list (edebug-form cursor))) | |
1646 | ||
1647 | (defalias 'edebug-match-place 'edebug-match-form) | |
1648 | ;; Currently identical to edebug-match-form. | |
1649 | ;; This is for common lisp setf-style place arguments. | |
1650 | ||
1651 | (defsubst edebug-match-body (cursor) (edebug-forms cursor)) | |
1652 | ||
1653 | (defun edebug-match-&optional (cursor specs) | |
1654 | ;; Keep matching until one spec fails. | |
1655 | (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) | |
1656 | ||
1657 | (defun edebug-&optional-wrapper (cursor specs remainder-handler) | |
1658 | (let (result | |
1659 | (edebug-&optional specs) | |
1660 | (edebug-gate nil) | |
1661 | (this-form (edebug-cursor-expressions cursor)) | |
1662 | (this-offset (edebug-cursor-offsets cursor))) | |
1663 | (if (null (catch 'no-match | |
1664 | (setq result | |
1665 | (edebug-match-specs cursor specs remainder-handler)) | |
1666 | ;; Returning nil means no no-match was thrown. | |
1667 | nil)) | |
1668 | result | |
1669 | ;; no-match, but don't fail; just reset cursor and return nil. | |
1670 | (edebug-set-cursor cursor this-form this-offset) | |
1671 | nil))) | |
1672 | ||
1673 | ||
1674 | (defun edebug-&rest-wrapper (cursor specs remainder-handler) | |
1675 | (if (null specs) (setq specs edebug-&rest)) | |
1676 | ;; Reuse the &optional handler with this as the remainder handler. | |
1677 | (edebug-&optional-wrapper cursor specs remainder-handler)) | |
a1506d29 | 1678 | |
1fe3d507 DL |
1679 | (defun edebug-match-&rest (cursor specs) |
1680 | ;; Repeatedly use specs until failure. | |
1681 | (let ((edebug-&rest specs) ;; remember these | |
1682 | edebug-best-error | |
1683 | edebug-error-point) | |
1684 | (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) | |
1685 | ||
1686 | ||
1687 | (defun edebug-match-&or (cursor specs) | |
1688 | ;; Keep matching until one spec succeeds, and return its results. | |
1689 | ;; If none match, fail. | |
1690 | ;; This needs to be optimized since most specs spend time here. | |
1691 | (let ((original-specs specs) | |
1692 | (this-form (edebug-cursor-expressions cursor)) | |
1693 | (this-offset (edebug-cursor-offsets cursor))) | |
1694 | (catch 'matched | |
1695 | (while specs | |
1696 | (catch 'no-match | |
1697 | (throw 'matched | |
1698 | (let (edebug-gate ;; only while matching each spec | |
1699 | edebug-best-error | |
1700 | edebug-error-point) | |
f7359658 | 1701 | ;; Doesn't support e.g. &or symbolp &rest form |
1fe3d507 DL |
1702 | (edebug-match-one-spec cursor (car specs))))) |
1703 | ;; Match failed, so reset and try again. | |
1704 | (setq specs (cdr specs)) | |
1705 | ;; Reset the cursor for the next match. | |
1706 | (edebug-set-cursor cursor this-form this-offset)) | |
1707 | ;; All failed. | |
1708 | (apply 'edebug-no-match cursor "Expected one of" original-specs)) | |
84fc2cfa ER |
1709 | )) |
1710 | ||
1711 | ||
1fe3d507 DL |
1712 | (defun edebug-match-¬ (cursor specs) |
1713 | ;; If any specs match, then fail | |
1714 | (if (null (catch 'no-match | |
1715 | (let ((edebug-gate nil)) | |
1716 | (save-excursion | |
1717 | (edebug-match-&or cursor specs))) | |
1718 | nil)) | |
1719 | ;; This means something matched, so it is a no match. | |
1720 | (edebug-no-match cursor "Unexpected")) | |
1721 | ;; This means nothing matched, so it is OK. | |
1722 | nil) ;; So, return nothing | |
a1506d29 | 1723 | |
1fe3d507 DL |
1724 | |
1725 | (def-edebug-spec &key edebug-match-&key) | |
1726 | ||
1727 | (defun edebug-match-&key (cursor specs) | |
1728 | ;; Following specs must look like (<name> <spec>) ... | |
1729 | ;; where <name> is the name of a keyword, and spec is its spec. | |
f7359658 | 1730 | ;; This really doesn't save much over the expanded form and takes time. |
a1506d29 | 1731 | (edebug-match-&rest |
1fe3d507 | 1732 | cursor |
a1506d29 | 1733 | (cons '&or |
1fe3d507 | 1734 | (mapcar (function (lambda (pair) |
a1506d29 | 1735 | (vector (format ":%s" (car pair)) |
1fe3d507 DL |
1736 | (car (cdr pair))))) |
1737 | specs)))) | |
1738 | ||
1739 | ||
bd8d6108 | 1740 | (defun edebug-match-gate (_cursor) |
1fe3d507 DL |
1741 | ;; Simply set the gate to prevent backtracking at this level. |
1742 | (setq edebug-gate t) | |
1743 | nil) | |
1744 | ||
1745 | ||
1746 | (defun edebug-match-list (cursor specs) | |
1747 | ;; The spec is a list, but what kind of list, and what context? | |
1748 | (if edebug-dotted-spec | |
a1506d29 | 1749 | ;; After dotted spec but form did not contain dot, |
1fe3d507 DL |
1750 | ;; so match list spec elements as if spliced in. |
1751 | (prog1 | |
1752 | (let ((edebug-dotted-spec)) | |
1753 | (edebug-match-specs cursor specs 'edebug-match-specs)) | |
1754 | ;; If it matched, really clear the dotted-spec flag. | |
1755 | (setq edebug-dotted-spec nil)) | |
1756 | (let ((spec (car specs)) | |
1757 | (form (edebug-top-element-required cursor "Expected" specs))) | |
1758 | (cond | |
1759 | ((eq 'quote spec) | |
1760 | (let ((spec (car (cdr specs)))) | |
1761 | (cond | |
1762 | ((symbolp spec) | |
1763 | ;; Special case: spec quotes a symbol to match. | |
1764 | ;; Change in future. Use "..." instead. | |
1765 | (if (not (eq spec form)) | |
1766 | (edebug-no-match cursor "Expected" spec)) | |
1767 | (edebug-move-cursor cursor) | |
1768 | (setq edebug-gate t) | |
1769 | form) | |
a1506d29 | 1770 | (t |
1fe3d507 DL |
1771 | (error "Bad spec: %s" specs))))) |
1772 | ||
1773 | ((listp form) | |
1774 | (prog1 | |
a1506d29 | 1775 | (list (edebug-match-sublist |
1fe3d507 DL |
1776 | ;; First offset is for the list form itself. |
1777 | ;; Treat nil as empty list. | |
a1506d29 | 1778 | (edebug-new-cursor form (cdr (edebug-top-offset cursor))) |
1fe3d507 DL |
1779 | specs)) |
1780 | (edebug-move-cursor cursor))) | |
1781 | ||
1782 | ((and (eq 'vector spec) (vectorp form)) | |
1783 | ;; Special case: match a vector with the specs. | |
1784 | (let ((result (edebug-match-sublist | |
a1506d29 | 1785 | (edebug-new-cursor |
1fe3d507 DL |
1786 | form (cdr (edebug-top-offset cursor))) |
1787 | (cdr specs)))) | |
1788 | (edebug-move-cursor cursor) | |
1789 | (list (apply 'vector result)))) | |
a1506d29 | 1790 | |
1fe3d507 DL |
1791 | (t (edebug-no-match cursor "Expected" specs))) |
1792 | ))) | |
84fc2cfa ER |
1793 | |
1794 | ||
1fe3d507 DL |
1795 | (defun edebug-match-sublist (cursor specs) |
1796 | ;; Match a sublist of specs. | |
1797 | (let (edebug-&optional | |
1798 | ;;edebug-best-error | |
1799 | ;;edebug-error-point | |
1800 | ) | |
a1506d29 | 1801 | (prog1 |
1fe3d507 DL |
1802 | ;; match with edebug-match-specs so edebug-best-error is not bound. |
1803 | (edebug-match-specs cursor specs 'edebug-match-specs) | |
1804 | (if (not (edebug-empty-cursor cursor)) | |
a1506d29 | 1805 | (if edebug-best-error |
1fe3d507 DL |
1806 | (apply 'edebug-no-match cursor edebug-best-error) |
1807 | ;; A failed &rest or &optional spec may leave some args. | |
1808 | (edebug-no-match cursor "Failed matching" specs) | |
1809 | ))))) | |
1810 | ||
1811 | ||
1812 | (defun edebug-match-string (cursor spec) | |
1813 | (let ((sexp (edebug-top-element-required cursor "Expected" spec))) | |
1814 | (if (not (eq (intern spec) sexp)) | |
1815 | (edebug-no-match cursor "Expected" spec) | |
1816 | ;; Since it matched, failure means immediate error, unless &optional. | |
1817 | (setq edebug-gate t) | |
1818 | (edebug-move-cursor cursor) | |
1819 | (list sexp) | |
1820 | ))) | |
84fc2cfa | 1821 | |
1fe3d507 DL |
1822 | (defun edebug-match-nil (cursor) |
1823 | ;; There must be nothing left to match a nil. | |
1824 | (if (not (edebug-empty-cursor cursor)) | |
1825 | (edebug-no-match cursor "Unmatched argument(s)") | |
1826 | nil)) | |
1827 | ||
1828 | ||
bd8d6108 | 1829 | (defun edebug-match-function (_cursor) |
1fe3d507 DL |
1830 | (error "Use function-form instead of function in edebug spec")) |
1831 | ||
1832 | (defun edebug-match-&define (cursor specs) | |
1833 | ;; Match a defining form. | |
f7359658 | 1834 | ;; Normally, &define is interpreted specially other places. |
1fe3d507 DL |
1835 | ;; This should only be called inside of a spec list to match the remainder |
1836 | ;; of the current list. e.g. ("lambda" &define args def-body) | |
1837 | (edebug-make-form-wrapper | |
a1506d29 | 1838 | cursor |
1fe3d507 DL |
1839 | (edebug-before-offset cursor) |
1840 | ;; Find the last offset in the list. | |
1841 | (let ((offsets (edebug-cursor-offsets cursor))) | |
1842 | (while (consp offsets) (setq offsets (cdr offsets))) | |
1843 | offsets) | |
1844 | specs)) | |
1845 | ||
1846 | (defun edebug-match-lambda-expr (cursor) | |
1847 | ;; The expression must be a function. | |
1848 | ;; This will match any list form that begins with a symbol | |
1849 | ;; that has an edebug-form-spec beginning with &define. In | |
a1506d29 | 1850 | ;; practice, only lambda expressions should be used. |
1fe3d507 | 1851 | ;; I could add a &lambda specification to avoid confusion. |
a1506d29 | 1852 | (let* ((sexp (edebug-top-element-required |
1fe3d507 DL |
1853 | cursor "Expected lambda expression")) |
1854 | (offset (edebug-top-offset cursor)) | |
1855 | (head (and (consp sexp) (car sexp))) | |
1856 | (spec (and (symbolp head) (get-edebug-spec head))) | |
1857 | (edebug-inside-func nil)) | |
1858 | ;; Find out if this is a defining form from first symbol. | |
1859 | (if (and (consp spec) (eq '&define (car spec))) | |
1860 | (prog1 | |
1861 | (list | |
a1506d29 | 1862 | (edebug-defining-form |
1fe3d507 DL |
1863 | (edebug-new-cursor sexp offset) |
1864 | (car offset);; before the sexp | |
a1506d29 | 1865 | (edebug-after-offset cursor) |
1fe3d507 DL |
1866 | (cons (symbol-name head) (cdr spec)))) |
1867 | (edebug-move-cursor cursor)) | |
1868 | (edebug-no-match cursor "Expected lambda expression") | |
1869 | ))) | |
84fc2cfa | 1870 | |
84fc2cfa | 1871 | |
1fe3d507 DL |
1872 | (defun edebug-match-name (cursor) |
1873 | ;; Set the edebug-def-name bound in edebug-defining-form. | |
1874 | (let ((name (edebug-top-element-required cursor "Expected name"))) | |
1875 | ;; Maybe strings and numbers could be used. | |
1876 | (if (not (symbolp name)) | |
1877 | (edebug-no-match cursor "Symbol expected for name of definition")) | |
1878 | (setq edebug-def-name | |
1879 | (if edebug-def-name | |
1880 | ;; Construct a new name by appending to previous name. | |
1881 | (intern (format "%s@%s" edebug-def-name name)) | |
1882 | name)) | |
1883 | (edebug-move-cursor cursor) | |
1884 | (list name))) | |
1885 | ||
bd8d6108 | 1886 | (defun edebug-match-colon-name (_cursor spec) |
1fe3d507 DL |
1887 | ;; Set the edebug-def-name to the spec. |
1888 | (setq edebug-def-name | |
1889 | (if edebug-def-name | |
1890 | ;; Construct a new name by appending to previous name. | |
1891 | (intern (format "%s@%s" edebug-def-name spec)) | |
1892 | spec)) | |
1893 | nil) | |
1894 | ||
1895 | (defun edebug-match-arg (cursor) | |
1896 | ;; set the def-args bound in edebug-defining-form | |
1897 | (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) | |
1898 | (if (or (not (symbolp edebug-arg)) | |
f7359658 | 1899 | (edebug-lambda-list-keywordp edebug-arg)) |
1fe3d507 DL |
1900 | (edebug-no-match cursor "Bad argument:" edebug-arg)) |
1901 | (edebug-move-cursor cursor) | |
1902 | (setq edebug-def-args (cons edebug-arg edebug-def-args)) | |
1903 | (list edebug-arg))) | |
1904 | ||
1905 | (defun edebug-match-def-form (cursor) | |
1906 | ;; Like form but the form is wrapped in edebug-enter form. | |
1907 | ;; The form is assumed to be executing outside of the function context. | |
1908 | ;; This is a hack for now, since a def-form might execute inside as well. | |
1909 | ;; Not to be used otherwise. | |
1910 | (let ((edebug-inside-func nil)) | |
1911 | (list (edebug-make-enter-wrapper (list (edebug-form cursor)))))) | |
1912 | ||
1913 | (defun edebug-match-def-body (cursor) | |
1914 | ;; Like body but body is wrapped in edebug-enter form. | |
1915 | ;; The body is assumed to be executing inside of the function context. | |
1916 | ;; Not to be used otherwise. | |
1917 | (let ((edebug-inside-func t)) | |
1918 | (list (edebug-wrap-def-body (edebug-forms cursor))))) | |
1919 | ||
1920 | ||
1921 | ;;;; Edebug Form Specs | |
1922 | ;;; ========================================================== | |
1fe3d507 DL |
1923 | |
1924 | ;;;;* Spec for def-edebug-spec | |
1925 | ;;; Out of date. | |
1926 | ||
1927 | (defun edebug-spec-p (object) | |
1928 | "Return non-nil if OBJECT is a symbol with an edebug-form-spec property." | |
1929 | (and (symbolp object) | |
1930 | (get object 'edebug-form-spec))) | |
1931 | ||
1932 | (def-edebug-spec def-edebug-spec | |
1933 | ;; Top level is different from lower levels. | |
f71974e1 | 1934 | (&define :name edebug-spec name |
1fe3d507 DL |
1935 | &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec))) |
1936 | ||
1937 | (def-edebug-spec edebug-spec-list | |
1938 | ;; A list must have something in it, or it is nil, a symbolp | |
1939 | ((edebug-spec . [&or nil edebug-spec]))) | |
1940 | ||
1941 | (def-edebug-spec edebug-spec | |
1942 | (&or | |
1943 | (vector &rest edebug-spec) ; matches a vector | |
1944 | ("vector" &rest edebug-spec) ; matches a vector spec | |
1945 | ("quote" symbolp) | |
1946 | edebug-spec-list | |
1947 | stringp | |
f7359658 | 1948 | [edebug-lambda-list-keywordp &rest edebug-spec] |
be0dd657 | 1949 | [keywordp gate edebug-spec] |
1fe3d507 DL |
1950 | edebug-spec-p ;; Including all the special ones e.g. form. |
1951 | symbolp;; a predicate | |
1952 | )) | |
84fc2cfa ER |
1953 | |
1954 | ||
f7359658 | 1955 | ;;;* Emacs special forms and some functions. |
84fc2cfa | 1956 | |
1fe3d507 DL |
1957 | ;; quote expects only one argument, although it allows any number. |
1958 | (def-edebug-spec quote sexp) | |
84fc2cfa | 1959 | |
1fe3d507 DL |
1960 | ;; The standard defining forms. |
1961 | (def-edebug-spec defconst defvar) | |
1962 | (def-edebug-spec defvar (symbolp &optional form stringp)) | |
84fc2cfa | 1963 | |
1fe3d507 DL |
1964 | (def-edebug-spec defun |
1965 | (&define name lambda-list | |
1966 | [&optional stringp] | |
1967 | [&optional ("interactive" interactive)] | |
1968 | def-body)) | |
1e46f9e4 | 1969 | ;; FIXME? Isn't this missing the doc-string? Cf defun. |
1fe3d507 | 1970 | (def-edebug-spec defmacro |
bd8d6108 SM |
1971 | ;; FIXME: Improve `declare' so we can Edebug gv-expander and |
1972 | ;; gv-setter declarations. | |
5121ef4c | 1973 | (&define name lambda-list [&optional ("declare" &rest sexp)] def-body)) |
84fc2cfa | 1974 | |
f7359658 | 1975 | (def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list. |
84fc2cfa | 1976 | |
1fe3d507 DL |
1977 | (def-edebug-spec lambda-list |
1978 | (([&rest arg] | |
1979 | [&optional ["&optional" arg &rest arg]] | |
1980 | &optional ["&rest" arg] | |
1981 | ))) | |
84fc2cfa | 1982 | |
1fe3d507 DL |
1983 | (def-edebug-spec interactive |
1984 | (&optional &or stringp def-form)) | |
84fc2cfa | 1985 | |
1fe3d507 DL |
1986 | ;; A function-form is for an argument that may be a function or a form. |
1987 | ;; This specially recognizes anonymous functions quoted with quote. | |
1988 | (def-edebug-spec function-form | |
1989 | ;; form at the end could also handle "function", | |
1990 | ;; but recognize it specially to avoid wrapping function forms. | |
1991 | (&or ([&or "quote" "function"] &or symbolp lambda-expr) form)) | |
84fc2cfa | 1992 | |
1fe3d507 DL |
1993 | ;; function expects a symbol or a lambda or macro expression |
1994 | ;; A macro is allowed by Emacs. | |
1995 | (def-edebug-spec function (&or symbolp lambda-expr)) | |
84fc2cfa | 1996 | |
1fe3d507 DL |
1997 | ;; A macro expression is a lambda expression with "macro" prepended. |
1998 | (def-edebug-spec macro (&define "lambda" lambda-list def-body)) | |
1999 | ||
2000 | ;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro]))) | |
2001 | ||
2002 | ;; Standard functions that take function-forms arguments. | |
1fe3d507 | 2003 | |
0b021094 GM |
2004 | ;; FIXME? The manual uses this form (maybe that's just for illustration?): |
2005 | ;; (def-edebug-spec let | |
2006 | ;; ((&rest &or symbolp (gate symbolp &optional form)) | |
2007 | ;; body)) | |
1fe3d507 DL |
2008 | (def-edebug-spec let |
2009 | ((&rest &or (symbolp &optional form) symbolp) | |
2010 | body)) | |
2011 | ||
2012 | (def-edebug-spec let* let) | |
2013 | ||
2014 | (def-edebug-spec setq (&rest symbolp form)) | |
2015 | (def-edebug-spec setq-default setq) | |
2016 | ||
2017 | (def-edebug-spec cond (&rest (&rest form))) | |
2018 | ||
2019 | (def-edebug-spec condition-case | |
2020 | (symbolp | |
2021 | form | |
284795f8 | 2022 | &rest ([&or symbolp (&rest symbolp)] body))) |
1fe3d507 DL |
2023 | |
2024 | ||
f7359658 | 2025 | (def-edebug-spec \` (backquote-form)) |
1fe3d507 | 2026 | |
a1506d29 | 2027 | ;; Supports quotes inside backquotes, |
1fe3d507 DL |
2028 | ;; but only at the top level inside unquotes. |
2029 | (def-edebug-spec backquote-form | |
2030 | (&or | |
2031 | ([&or "," ",@"] &or ("quote" backquote-form) form) | |
d778509c SM |
2032 | ;; The simple version: |
2033 | ;; (backquote-form &rest backquote-form) | |
2034 | ;; doesn't handle (a . ,b). The straightforward fix: | |
2035 | ;; (backquote-form . [&or nil backquote-form]) | |
2036 | ;; uses up too much stack space. | |
f4c4910c | 2037 | ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it. |
d778509c SM |
2038 | (backquote-form [&rest [¬ ","] backquote-form] |
2039 | . [&or nil backquote-form]) | |
1fe3d507 DL |
2040 | ;; If you use dotted forms in backquotes, replace the previous line |
2041 | ;; with the following. This takes quite a bit more stack space, however. | |
2042 | ;; (backquote-form . [&or nil backquote-form]) | |
2043 | (vector &rest backquote-form) | |
2044 | sexp)) | |
84fc2cfa | 2045 | |
1fe3d507 DL |
2046 | ;; Special version of backquote that instruments backquoted forms |
2047 | ;; destined to be evaluated, usually as the result of a | |
2048 | ;; macroexpansion. Backquoted code can only have unquotes (, and ,@) | |
2049 | ;; in places where list forms are allowed, and predicates. If the | |
2050 | ;; backquote is used in a macro, unquoted code that come from | |
2051 | ;; arguments must be instrumented, if at all, with def-form not def-body. | |
84fc2cfa | 2052 | |
1fe3d507 DL |
2053 | ;; We could assume that all forms (not nested in other forms) |
2054 | ;; in arguments of macros should be def-forms, whether or not the macros | |
2055 | ;; are defined with edebug-` but this would be expensive. | |
84fc2cfa | 2056 | |
1fe3d507 DL |
2057 | ;; ,@ might have some problems. |
2058 | ||
f7359658 RS |
2059 | (defalias 'edebug-\` '\`) ;; same macro as regular backquote. |
2060 | (def-edebug-spec edebug-\` (def-form)) | |
1fe3d507 DL |
2061 | |
2062 | ;; Assume immediate quote in unquotes mean backquote at next higher level. | |
2fa9dc2f SM |
2063 | (def-edebug-spec \, (&or ("quote" edebug-\`) def-form)) |
2064 | (def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped. | |
99edd7ed | 2065 | &or ("quote" edebug-\`) def-form)) |
1fe3d507 DL |
2066 | |
2067 | ;; New byte compiler. | |
1fe3d507 | 2068 | |
8fd29408 RS |
2069 | (def-edebug-spec save-selected-window t) |
2070 | (def-edebug-spec save-current-buffer t) | |
01a9e593 | 2071 | |
1fe3d507 DL |
2072 | ;; Anything else? |
2073 | ||
f7359658 | 2074 | ;;; The debugger itself |
1fe3d507 DL |
2075 | |
2076 | (defvar edebug-active nil) ;; Non-nil when edebug is active | |
84fc2cfa | 2077 | |
1fe3d507 DL |
2078 | (defvar edebug-stack nil) |
2079 | ;; Stack of active functions evaluated via edebug. | |
2080 | ;; Should be nil at the top level. | |
2081 | ||
2082 | (defvar edebug-stack-depth -1) | |
2083 | ;; Index of last edebug-stack item. | |
2084 | ||
2085 | (defvar edebug-offset-indices nil) | |
2086 | ;; Stack of offset indices of visited edebug sexps. | |
2087 | ;; Should be nil at the top level. | |
2088 | ;; Each function adds one cons. Top is modified with setcar. | |
84fc2cfa | 2089 | |
84fc2cfa ER |
2090 | |
2091 | (defvar edebug-entered nil | |
1fe3d507 DL |
2092 | ;; Non-nil if edebug has already been entered at this recursive edit level. |
2093 | ;; This should stay nil at the top level. | |
2094 | ) | |
2095 | ||
2096 | ;; Should these be options? | |
2097 | (defconst edebug-debugger 'edebug | |
2098 | ;; Name of function to use for debugging when error or quit occurs. | |
2099 | ;; Set this to 'debug if you want to debug edebug. | |
2100 | ) | |
2101 | ||
2102 | ||
2103 | ;; Dynamically bound variables, declared globally but left unbound. | |
2104 | (defvar edebug-function) ; the function being executed. change name!! | |
1fe3d507 | 2105 | (defvar edebug-data) ; the edebug data for the function |
1fe3d507 DL |
2106 | (defvar edebug-def-mark) ; the mark for the definition |
2107 | (defvar edebug-freq-count) ; the count of expression visits. | |
2108 | (defvar edebug-coverage) ; the coverage results of each expression of function. | |
2109 | ||
2110 | (defvar edebug-buffer) ; which buffer the function is in. | |
1fe3d507 DL |
2111 | (defvar edebug-outside-executing-macro) |
2112 | (defvar edebug-outside-defining-kbd-macro) | |
2113 | ||
2114 | (defvar edebug-execution-mode 'step) ; Current edebug mode set by user. | |
2115 | (defvar edebug-next-execution-mode nil) ; Use once instead of initial mode. | |
2116 | ||
2117 | (defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside | |
2118 | (defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside | |
2119 | ||
17b76fbd | 2120 | |
88668147 DL |
2121 | (defvar edebug-outside-pre-command-hook) |
2122 | (defvar edebug-outside-post-command-hook) | |
88668147 DL |
2123 | |
2124 | (defvar cl-lexical-debug) ;; Defined in cl.el | |
2125 | ||
1fe3d507 | 2126 | ;;; Handling signals |
1fe3d507 | 2127 | |
bd8d6108 | 2128 | (defun edebug-signal (signal-name signal-data) |
1fe3d507 DL |
2129 | "Signal an error. Args are SIGNAL-NAME, and associated DATA. |
2130 | A signal name is a symbol with an `error-conditions' property | |
2131 | that is a list of condition names. | |
2132 | A handler for any of those names will get to handle this signal. | |
2133 | The symbol `error' should always be one of them. | |
2134 | ||
2135 | DATA should be a list. Its elements are printed as part of the error message. | |
2136 | If the signal is handled, DATA is made available to the handler. | |
2137 | See `condition-case'. | |
2138 | ||
2139 | This is the Edebug replacement for the standard `signal'. It should | |
2140 | only be active while Edebug is. It checks `debug-on-error' to see | |
2141 | whether it should call the debugger. When execution is resumed, the | |
bd8d6108 SM |
2142 | error is signaled again." |
2143 | (if (and (listp debug-on-error) (memq signal-name debug-on-error)) | |
2144 | (edebug 'error (cons signal-name signal-data))) | |
1fe3d507 DL |
2145 | ;; If we reach here without another non-local exit, then send signal again. |
2146 | ;; i.e. the signal is not continuable, yet. | |
e76b547b RS |
2147 | ;; Avoid infinite recursion. |
2148 | (let ((signal-hook-function nil)) | |
bd8d6108 | 2149 | (signal signal-name signal-data))) |
1fe3d507 DL |
2150 | |
2151 | ;;; Entering Edebug | |
84fc2cfa | 2152 | |
bd8d6108 | 2153 | (defun edebug-enter (function args body) |
1fe3d507 DL |
2154 | ;; Entering FUNC. The arguments are ARGS, and the body is BODY. |
2155 | ;; Setup edebug variables and evaluate BODY. This function is called | |
a1506d29 | 2156 | ;; when a function evaluated with edebug-eval-top-level-form is entered. |
1fe3d507 | 2157 | ;; Return the result of BODY. |
84fc2cfa ER |
2158 | |
2159 | ;; Is this the first time we are entering edebug since | |
2160 | ;; lower-level recursive-edit command? | |
1fe3d507 | 2161 | ;; More precisely, this tests whether Edebug is currently active. |
bd8d6108 SM |
2162 | (let ((edebug-function function)) |
2163 | (if (not edebug-entered) | |
2164 | (let ((edebug-entered t) | |
2165 | ;; Binding max-lisp-eval-depth here is OK, | |
2166 | ;; but not inside an unwind-protect. | |
2167 | ;; Doing it here also keeps it from growing too large. | |
2168 | (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much?? | |
2169 | (max-specpdl-size (+ 200 max-specpdl-size)) | |
2170 | ||
2171 | (debugger edebug-debugger) ; only while edebug is active. | |
2172 | (edebug-outside-debug-on-error debug-on-error) | |
2173 | (edebug-outside-debug-on-quit debug-on-quit) | |
2174 | ;; Binding these may not be the right thing to do. | |
2175 | ;; We want to allow the global values to be changed. | |
2176 | (debug-on-error (or debug-on-error edebug-on-error)) | |
2177 | (debug-on-quit edebug-on-quit) | |
2178 | ||
2179 | ;; Lexical bindings must be uncompiled for this to work. | |
2180 | (cl-lexical-debug t)) | |
2181 | (unwind-protect | |
2182 | (let ((signal-hook-function 'edebug-signal)) | |
2183 | (setq edebug-execution-mode (or edebug-next-execution-mode | |
2184 | edebug-initial-mode | |
2185 | edebug-execution-mode) | |
2186 | edebug-next-execution-mode nil) | |
2187 | (edebug-enter function args body)))) | |
2188 | ||
2189 | (let* ((edebug-data (get function 'edebug)) | |
2190 | (edebug-def-mark (car edebug-data)) ; mark at def start | |
2191 | (edebug-freq-count (get function 'edebug-freq-count)) | |
2192 | (edebug-coverage (get function 'edebug-coverage)) | |
2193 | (edebug-buffer (marker-buffer edebug-def-mark)) | |
2194 | ||
2195 | (edebug-stack (cons function edebug-stack)) | |
2196 | (edebug-offset-indices (cons 0 edebug-offset-indices)) | |
2197 | ) | |
2198 | (if (get function 'edebug-on-entry) | |
2199 | (progn | |
2200 | (setq edebug-execution-mode 'step) | |
2201 | (if (eq (get function 'edebug-on-entry) 'temp) | |
2202 | (put function 'edebug-on-entry nil)))) | |
2203 | (if edebug-trace | |
2204 | (edebug--enter-trace function args body) | |
2205 | (funcall body)) | |
2206 | )))) | |
84fc2cfa | 2207 | |
5fc58d83 RS |
2208 | (defun edebug-var-status (var) |
2209 | "Return a cons cell describing the status of VAR's current binding. | |
2210 | The purpose of this function is so you can properly undo | |
2211 | subsequent changes to the same binding, by passing the status | |
2212 | cons cell to `edebug-restore-status'. The status cons cell | |
2213 | has the form (LOCUS . VALUE), where LOCUS can be a buffer | |
2214 | \(for a buffer-local binding), a frame (for a frame-local binding), | |
2215 | or nil (if the default binding is current)." | |
2216 | (cons (variable-binding-locus var) | |
2217 | (symbol-value var))) | |
2218 | ||
2219 | (defun edebug-restore-status (var status) | |
2220 | "Reset VAR based on STATUS. | |
242b1f68 | 2221 | STATUS should be a list returned by `edebug-var-status'." |
5fc58d83 RS |
2222 | (let ((locus (car status)) |
2223 | (value (cdr status))) | |
2224 | (cond ((bufferp locus) | |
2225 | (if (buffer-live-p locus) | |
2226 | (with-current-buffer locus | |
2227 | (set var value)))) | |
2228 | ((framep locus) | |
2229 | (modify-frame-parameters locus (list (cons var value)))) | |
2230 | (t | |
2231 | (set var value))))) | |
84fc2cfa | 2232 | |
bd8d6108 | 2233 | (defun edebug--enter-trace (function args body) |
1fe3d507 DL |
2234 | (let ((edebug-stack-depth (1+ edebug-stack-depth)) |
2235 | edebug-result) | |
a1506d29 | 2236 | (edebug-print-trace-before |
bd8d6108 SM |
2237 | (format "%s args: %s" function args)) |
2238 | (prog1 (setq edebug-result (funcall body)) | |
1fe3d507 | 2239 | (edebug-print-trace-after |
bd8d6108 | 2240 | (format "%s result: %s" function edebug-result))))) |
1fe3d507 DL |
2241 | |
2242 | (def-edebug-spec edebug-tracing (form body)) | |
2243 | ||
2244 | (defmacro edebug-tracing (msg &rest body) | |
2245 | "Print MSG in *edebug-trace* before and after evaluating BODY. | |
2246 | The result of BODY is also printed." | |
d8f1319a GM |
2247 | `(let ((edebug-stack-depth (1+ edebug-stack-depth)) |
2248 | edebug-result) | |
2249 | (edebug-print-trace-before ,msg) | |
2250 | (prog1 (setq edebug-result (progn ,@body)) | |
a1506d29 | 2251 | (edebug-print-trace-after |
d8f1319a | 2252 | (format "%s result: %s" ,msg edebug-result))))) |
1fe3d507 DL |
2253 | |
2254 | (defun edebug-print-trace-before (msg) | |
2255 | "Function called to print trace info before expression evaluation. | |
2256 | MSG is printed after `::::{ '." | |
84fc2cfa | 2257 | (edebug-trace-display |
1fe3d507 | 2258 | edebug-trace-buffer "%s{ %s" (make-string edebug-stack-depth ?\:) msg)) |
84fc2cfa | 2259 | |
1fe3d507 DL |
2260 | (defun edebug-print-trace-after (msg) |
2261 | "Function called to print trace info after expression evaluation. | |
2262 | MSG is printed after `::::} '." | |
84fc2cfa | 2263 | (edebug-trace-display |
1fe3d507 DL |
2264 | edebug-trace-buffer "%s} %s" (make-string edebug-stack-depth ?\:) msg)) |
2265 | ||
2266 | ||
84fc2cfa | 2267 | |
bd8d6108 | 2268 | (defun edebug-slow-before (before-index) |
3cc9e6d8 RS |
2269 | (unless edebug-active |
2270 | ;; Debug current function given BEFORE position. | |
2271 | ;; Called from functions compiled with edebug-eval-top-level-form. | |
2272 | ;; Return the before index. | |
bd8d6108 | 2273 | (setcar edebug-offset-indices before-index) |
3cc9e6d8 RS |
2274 | |
2275 | ;; Increment frequency count | |
bd8d6108 SM |
2276 | (aset edebug-freq-count before-index |
2277 | (1+ (aref edebug-freq-count before-index))) | |
3cc9e6d8 RS |
2278 | |
2279 | (if (or (not (memq edebug-execution-mode '(Go-nonstop next))) | |
2de39f08 | 2280 | (input-pending-p)) |
bd8d6108 SM |
2281 | (edebug-debugger before-index 'before nil))) |
2282 | before-index) | |
1fe3d507 | 2283 | |
bd8d6108 | 2284 | (defun edebug-fast-before (_before-index) |
1fe3d507 DL |
2285 | ;; Do nothing. |
2286 | ) | |
2287 | ||
bd8d6108 | 2288 | (defun edebug-slow-after (_before-index after-index value) |
3cc9e6d8 | 2289 | (if edebug-active |
bd8d6108 | 2290 | value |
3cc9e6d8 RS |
2291 | ;; Debug current function given AFTER position and VALUE. |
2292 | ;; Called from functions compiled with edebug-eval-top-level-form. | |
2293 | ;; Return VALUE. | |
bd8d6108 | 2294 | (setcar edebug-offset-indices after-index) |
3cc9e6d8 RS |
2295 | |
2296 | ;; Increment frequency count | |
bd8d6108 SM |
2297 | (aset edebug-freq-count after-index |
2298 | (1+ (aref edebug-freq-count after-index))) | |
2299 | (if edebug-test-coverage (edebug--update-coverage after-index value)) | |
3cc9e6d8 RS |
2300 | |
2301 | (if (and (eq edebug-execution-mode 'Go-nonstop) | |
2de39f08 | 2302 | (not (input-pending-p))) |
3cc9e6d8 | 2303 | ;; Just return result. |
bd8d6108 SM |
2304 | value |
2305 | (edebug-debugger after-index 'after value) | |
3cc9e6d8 | 2306 | ))) |
1fe3d507 | 2307 | |
bd8d6108 | 2308 | (defun edebug-fast-after (_before-index _after-index value) |
1fe3d507 | 2309 | ;; Do nothing but return the value. |
bd8d6108 | 2310 | value) |
1fe3d507 DL |
2311 | |
2312 | (defun edebug-run-slow () | |
2313 | (defalias 'edebug-before 'edebug-slow-before) | |
2314 | (defalias 'edebug-after 'edebug-slow-after)) | |
2315 | ||
2316 | ;; This is not used, yet. | |
2317 | (defun edebug-run-fast () | |
2318 | (defalias 'edebug-before 'edebug-fast-before) | |
2319 | (defalias 'edebug-after 'edebug-fast-after)) | |
2320 | ||
2321 | (edebug-run-slow) | |
2322 | ||
2323 | ||
bd8d6108 SM |
2324 | (defun edebug--update-coverage (after-index value) |
2325 | (let ((old-result (aref edebug-coverage after-index))) | |
1fe3d507 DL |
2326 | (cond |
2327 | ((eq 'ok-coverage old-result)) | |
2328 | ((eq 'unknown old-result) | |
bd8d6108 | 2329 | (aset edebug-coverage after-index value)) |
1fe3d507 | 2330 | ;; Test if a different result. |
bd8d6108 SM |
2331 | ((not (eq value old-result)) |
2332 | (aset edebug-coverage after-index 'ok-coverage))))) | |
1fe3d507 DL |
2333 | |
2334 | ||
2335 | ;; Dynamically declared unbound variables. | |
1fe3d507 DL |
2336 | (defvar edebug-breakpoints) |
2337 | (defvar edebug-break-data) ; break data for current function. | |
2338 | (defvar edebug-break) ; whether a break occurred. | |
2339 | (defvar edebug-global-break) ; whether a global break occurred. | |
2340 | (defvar edebug-break-condition) ; whether the breakpoint is conditional. | |
2341 | ||
2342 | (defvar edebug-break-result nil) | |
2343 | (defvar edebug-global-break-result nil) | |
2344 | ||
2345 | ||
bd8d6108 | 2346 | (defun edebug-debugger (offset-index arg-mode value) |
3795fe52 RS |
2347 | (if inhibit-redisplay |
2348 | ;; Don't really try to enter edebug within an eval from redisplay. | |
bd8d6108 | 2349 | value |
3795fe52 | 2350 | ;; Check breakpoints and pending input. |
bd8d6108 SM |
2351 | ;; If edebug display should be updated, call edebug--display. |
2352 | ;; Return value. | |
3795fe52 RS |
2353 | (let* ( ;; This needs to be here since breakpoints may be changed. |
2354 | (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints | |
bd8d6108 | 2355 | (edebug-break-data (assq offset-index edebug-breakpoints)) |
3795fe52 RS |
2356 | (edebug-break-condition (car (cdr edebug-break-data))) |
2357 | (edebug-global-break | |
2358 | (if edebug-global-break-condition | |
2359 | (condition-case nil | |
2360 | (setq edebug-global-break-result | |
a0ee6f27 | 2361 | ;; FIXME: lexbind. |
3795fe52 RS |
2362 | (eval edebug-global-break-condition)) |
2363 | (error nil)))) | |
2364 | (edebug-break)) | |
1fe3d507 | 2365 | |
bd8d6108 | 2366 | ;;(edebug-trace "exp: %s" value) |
3795fe52 | 2367 | ;; Test whether we should break. |
a1506d29 | 2368 | (setq edebug-break |
3795fe52 RS |
2369 | (or edebug-global-break |
2370 | (and edebug-break-data | |
2371 | (or (not edebug-break-condition) | |
2372 | (setq edebug-break-result | |
a0ee6f27 | 2373 | ;; FIXME: lexbind. |
3795fe52 RS |
2374 | (eval edebug-break-condition)))))) |
2375 | (if (and edebug-break | |
2376 | (nth 2 edebug-break-data)) ; is it temporary? | |
2377 | ;; Delete the breakpoint. | |
2378 | (setcdr edebug-data | |
2379 | (cons (delq edebug-break-data edebug-breakpoints) | |
2380 | (cdr (cdr edebug-data))))) | |
2381 | ||
2382 | ;; Display if mode is not go, continue, or Continue-fast | |
a1506d29 | 2383 | ;; or break, or input is pending, |
3795fe52 RS |
2384 | (if (or (not (memq edebug-execution-mode '(go continue Continue-fast))) |
2385 | edebug-break | |
2de39f08 | 2386 | (input-pending-p)) |
bd8d6108 | 2387 | (edebug--display value offset-index arg-mode)) ; <---------- display |
a1506d29 | 2388 | |
bd8d6108 | 2389 | value))) |
84fc2cfa ER |
2390 | |
2391 | ||
1fe3d507 DL |
2392 | ;; window-start now stored with each function. |
2393 | ;;(defvar edebug-window-start nil) | |
2394 | ;; Remember where each buffers' window starts between edebug calls. | |
2395 | ;; This is to avoid spurious recentering. | |
2396 | ;; Does this still need to be buffer-local?? | |
2397 | ;;(setq-default edebug-window-start nil) | |
2398 | ;;(make-variable-buffer-local 'edebug-window-start) | |
2399 | ||
2400 | ||
2401 | ;; Dynamically declared unbound vars | |
2402 | (defvar edebug-point) ; the point in edebug buffer | |
2403 | (defvar edebug-outside-buffer) ; the current-buffer outside of edebug | |
2404 | (defvar edebug-outside-point) ; the point outside of edebug | |
2405 | (defvar edebug-outside-mark) ; the mark outside of edebug | |
2406 | (defvar edebug-window-data) ; window and window-start for current function | |
2407 | (defvar edebug-outside-windows) ; outside window configuration | |
2408 | (defvar edebug-eval-buffer) ; for the evaluation list. | |
2409 | (defvar edebug-outside-o-a-p) ; outside overlay-arrow-position | |
2410 | (defvar edebug-outside-o-a-s) ; outside overlay-arrow-string | |
2411 | (defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area | |
eb533587 | 2412 | (defvar edebug-outside-d-c-i-n-s-w) ; outside default-cursor-in-non-selected-windows |
1fe3d507 DL |
2413 | |
2414 | (defvar edebug-eval-list nil) ;; List of expressions to evaluate. | |
2415 | ||
2416 | (defvar edebug-previous-result nil) ;; Last result returned. | |
2417 | ||
88668147 | 2418 | ;; Emacs 19 adds an arg to mark and mark-marker. |
1fe3d507 | 2419 | (defalias 'edebug-mark-marker 'mark-marker) |
84fc2cfa | 2420 | |
c0c54fbd | 2421 | (defvar edebug-outside-unread-command-events) |
84fc2cfa | 2422 | |
bd8d6108 | 2423 | (defun edebug--display (value offset-index arg-mode) |
e409c527 SM |
2424 | (unless (marker-position edebug-def-mark) |
2425 | ;; The buffer holding the source has been killed. | |
2426 | ;; Let's at least show a backtrace so the user can figure out | |
2427 | ;; which function we're talking about. | |
2428 | (debug)) | |
1fe3d507 DL |
2429 | ;; Setup windows for edebug, determine mode, maybe enter recursive-edit. |
2430 | ;; Uses local variables of edebug-enter, edebug-before, edebug-after | |
2431 | ;; and edebug-debugger. | |
bd8d6108 | 2432 | (let ((edebug-active t) ; For minor mode alist. |
3cc9e6d8 | 2433 | (edebug-with-timeout-suspend (with-timeout-suspend)) |
bd8d6108 | 2434 | edebug-stop ; Should we enter recursive-edit? |
1fe3d507 | 2435 | (edebug-point (+ edebug-def-mark |
bd8d6108 | 2436 | (aref (nth 2 edebug-data) offset-index))) |
1fe3d507 DL |
2437 | edebug-buffer-outside-point ; current point in edebug-buffer |
2438 | ;; window displaying edebug-buffer | |
2439 | (edebug-window-data (nth 3 edebug-data)) | |
84fc2cfa ER |
2440 | (edebug-outside-window (selected-window)) |
2441 | (edebug-outside-buffer (current-buffer)) | |
2442 | (edebug-outside-point (point)) | |
1fe3d507 | 2443 | (edebug-outside-mark (edebug-mark)) |
3a799327 | 2444 | (edebug-outside-unread-command-events unread-command-events) |
bd8d6108 | 2445 | edebug-outside-windows ; Window or screen configuration. |
1fe3d507 | 2446 | edebug-buffer-points |
a1506d29 | 2447 | |
bd8d6108 SM |
2448 | edebug-eval-buffer ; Declared here so we can kill it below. |
2449 | (eval-result-list (and edebug-eval-list | |
2450 | (edebug-eval-result-list))) | |
1fe3d507 DL |
2451 | edebug-trace-window |
2452 | edebug-trace-window-start | |
88668147 DL |
2453 | |
2454 | (edebug-outside-o-a-p overlay-arrow-position) | |
2455 | (edebug-outside-o-a-s overlay-arrow-string) | |
eb533587 | 2456 | (edebug-outside-c-i-e-a cursor-in-echo-area) |
de70529f SM |
2457 | (edebug-outside-d-c-i-n-s-w |
2458 | (default-value 'cursor-in-non-selected-windows))) | |
88668147 DL |
2459 | (unwind-protect |
2460 | (let ((overlay-arrow-position overlay-arrow-position) | |
2461 | (overlay-arrow-string overlay-arrow-string) | |
2462 | (cursor-in-echo-area nil) | |
2de39f08 | 2463 | (unread-command-events nil) |
88668147 DL |
2464 | ;; any others?? |
2465 | ) | |
de70529f | 2466 | (setq-default cursor-in-non-selected-windows t) |
88668147 DL |
2467 | (if (not (buffer-name edebug-buffer)) |
2468 | (let ((debug-on-error nil)) | |
2469 | (error "Buffer defining %s not found" edebug-function))) | |
a1506d29 | 2470 | |
bd8d6108 | 2471 | (if (eq 'after arg-mode) |
88668147 | 2472 | ;; Compute result string now before windows are modified. |
bd8d6108 | 2473 | (edebug-compute-previous-result value)) |
88668147 DL |
2474 | |
2475 | (if edebug-save-windows | |
2476 | ;; Save windows now before we modify them. | |
a1506d29 | 2477 | (setq edebug-outside-windows |
88668147 | 2478 | (edebug-current-windows edebug-save-windows))) |
a1506d29 | 2479 | |
88668147 DL |
2480 | (if edebug-save-displayed-buffer-points |
2481 | (setq edebug-buffer-points (edebug-get-displayed-buffer-points))) | |
2482 | ||
2483 | ;; First move the edebug buffer point to edebug-point | |
f7359658 RS |
2484 | ;; so that window start doesn't get changed when we display it. |
2485 | ;; I don't know if this is going to help. | |
88668147 DL |
2486 | ;;(set-buffer edebug-buffer) |
2487 | ;;(goto-char edebug-point) | |
2488 | ||
2489 | ;; If edebug-buffer is not currently displayed, | |
2490 | ;; first find a window for it. | |
2491 | (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)) | |
2492 | (setcar edebug-window-data (selected-window)) | |
2493 | ||
2494 | ;; Now display eval list, if any. | |
a1506d29 | 2495 | ;; This is done after the pop to edebug-buffer |
88668147 | 2496 | ;; so that buffer-window correspondence is correct after quitting. |
bd8d6108 | 2497 | (edebug-eval-display eval-result-list) |
88668147 DL |
2498 | ;; The evaluation list better not have deleted edebug-window-data. |
2499 | (select-window (car edebug-window-data)) | |
2500 | (set-buffer edebug-buffer) | |
2501 | ||
2502 | (setq edebug-buffer-outside-point (point)) | |
2503 | (goto-char edebug-point) | |
a1506d29 | 2504 | |
bd8d6108 | 2505 | (if (eq 'before arg-mode) |
88668147 DL |
2506 | ;; Check whether positions are up-to-date. |
2507 | ;; This assumes point is never before symbol. | |
2508 | (if (not (memq (following-char) '(?\( ?\# ?\` ))) | |
2509 | (let ((debug-on-error nil)) | |
a1506d29 | 2510 | (error "Source has changed - reevaluate definition of %s" |
88668147 DL |
2511 | edebug-function) |
2512 | ))) | |
1fe3d507 | 2513 | |
88668147 DL |
2514 | (setcdr edebug-window-data |
2515 | (edebug-adjust-window (cdr edebug-window-data))) | |
a1506d29 | 2516 | |
88668147 | 2517 | ;; Test if there is input, not including keyboard macros. |
2de39f08 | 2518 | (if (input-pending-p) |
88668147 DL |
2519 | (progn |
2520 | (setq edebug-execution-mode 'step | |
2521 | edebug-stop t) | |
2522 | (edebug-stop) | |
2523 | ;; (discard-input) ; is this unfriendly?? | |
2524 | )) | |
2525 | ;; Now display arrow based on mode. | |
2526 | (edebug-overlay-arrow) | |
a1506d29 | 2527 | |
88668147 | 2528 | (cond |
bd8d6108 | 2529 | ((eq 'error arg-mode) |
88668147 DL |
2530 | ;; Display error message |
2531 | (setq edebug-execution-mode 'step) | |
2532 | (edebug-overlay-arrow) | |
2533 | (beep) | |
bd8d6108 | 2534 | (if (eq 'quit (car value)) |
88668147 | 2535 | (message "Quit") |
bd8d6108 | 2536 | (edebug-report-error value))) |
88668147 DL |
2537 | (edebug-break |
2538 | (cond | |
2539 | (edebug-global-break | |
a1506d29 | 2540 | (message "Global Break: %s => %s" |
88668147 DL |
2541 | edebug-global-break-condition |
2542 | edebug-global-break-result)) | |
2543 | (edebug-break-condition | |
a1506d29 JB |
2544 | (message "Break: %s => %s" |
2545 | edebug-break-condition | |
88668147 DL |
2546 | edebug-break-result)) |
2547 | ((not (eq edebug-execution-mode 'Continue-fast)) | |
2548 | (message "Break")) | |
2549 | (t))) | |
2550 | ||
2551 | (t (message ""))) | |
2552 | ||
bd8d6108 | 2553 | (if (eq 'after arg-mode) |
88668147 DL |
2554 | (progn |
2555 | ;; Display result of previous evaluation. | |
2556 | (if (and edebug-break | |
2557 | (not (eq edebug-execution-mode 'Continue-fast))) | |
2de39f08 | 2558 | (sit-for edebug-sit-for-seconds)) ; Show message. |
88668147 | 2559 | (edebug-previous-result))) |
a1506d29 | 2560 | |
88668147 DL |
2561 | (cond |
2562 | (edebug-break | |
2563 | (cond | |
309411cb | 2564 | ((eq edebug-execution-mode 'continue) |
2de39f08 SM |
2565 | (sit-for edebug-sit-for-seconds)) |
2566 | ((eq edebug-execution-mode 'Continue-fast) (sit-for 0)) | |
88668147 DL |
2567 | (t (setq edebug-stop t)))) |
2568 | ;; not edebug-break | |
2569 | ((eq edebug-execution-mode 'trace) | |
2de39f08 | 2570 | (sit-for edebug-sit-for-seconds)) ; Force update and pause. |
88668147 | 2571 | ((eq edebug-execution-mode 'Trace-fast) |
2de39f08 | 2572 | (sit-for 0))) ; Force update and continue. |
a1506d29 | 2573 | |
88668147 DL |
2574 | (unwind-protect |
2575 | (if (or edebug-stop | |
2576 | (memq edebug-execution-mode '(step next)) | |
bd8d6108 | 2577 | (eq arg-mode 'error)) |
88668147 DL |
2578 | (progn |
2579 | ;; (setq edebug-execution-mode 'step) | |
f7359658 | 2580 | ;; (edebug-overlay-arrow) ; This doesn't always show up. |
bd8d6108 | 2581 | (edebug--recursive-edit arg-mode))) ; <----- Recursive edit |
88668147 DL |
2582 | |
2583 | ;; Reset the edebug-window-data to whatever it is now. | |
2584 | (let ((window (if (eq (window-buffer) edebug-buffer) | |
2585 | (selected-window) | |
2de39f08 | 2586 | (get-buffer-window edebug-buffer)))) |
88668147 DL |
2587 | ;; Remember window-start for edebug-buffer, if still displayed. |
2588 | (if window | |
2589 | (progn | |
2590 | (setcar edebug-window-data window) | |
2591 | (setcdr edebug-window-data (window-start window))))) | |
1fe3d507 | 2592 | |
88668147 DL |
2593 | ;; Save trace window point before restoring outside windows. |
2594 | ;; Could generalize this for other buffers. | |
2595 | (setq edebug-trace-window (get-buffer-window edebug-trace-buffer)) | |
2596 | (if edebug-trace-window | |
2597 | (setq edebug-trace-window-start | |
a1506d29 | 2598 | (and edebug-trace-window |
88668147 DL |
2599 | (window-start edebug-trace-window)))) |
2600 | ||
2601 | ;; Restore windows before continuing. | |
2602 | (if edebug-save-windows | |
2603 | (progn | |
2604 | (edebug-set-windows edebug-outside-windows) | |
2605 | ||
2606 | ;; Restore displayed buffer points. | |
2607 | ;; Needed even if restoring windows because | |
2608 | ;; window-points are not restored. (should they be??) | |
2609 | (if edebug-save-displayed-buffer-points | |
2610 | (edebug-set-buffer-points edebug-buffer-points)) | |
2611 | ||
2612 | ;; Unrestore trace window's window-point. | |
2613 | (if edebug-trace-window | |
a1506d29 | 2614 | (set-window-start edebug-trace-window |
88668147 DL |
2615 | edebug-trace-window-start)) |
2616 | ||
2617 | ;; Unrestore edebug-buffer's window-start, if displayed. | |
2618 | (let ((window (car edebug-window-data))) | |
1b96c77f | 2619 | (if (and (edebug-window-live-p window) |
88668147 DL |
2620 | (eq (window-buffer) edebug-buffer)) |
2621 | (progn | |
a1506d29 | 2622 | (set-window-start window (cdr edebug-window-data) |
88668147 DL |
2623 | 'no-force) |
2624 | ;; Unrestore edebug-buffer's window-point. | |
2625 | ;; Needed in addition to setting the buffer point | |
f7359658 | 2626 | ;; - otherwise quitting doesn't leave point as is. |
88668147 DL |
2627 | ;; But this causes point to not be restored at times. |
2628 | ;; Also, it may not be a visible window. | |
2629 | ;; (set-window-point window edebug-point) | |
2630 | ))) | |
2631 | ||
2632 | ;; Unrestore edebug-buffer's point. Rerestored below. | |
2633 | ;; (goto-char edebug-point) ;; in edebug-buffer | |
2634 | ) | |
2635 | ;; Since we may be in a save-excursion, in case of quit, | |
2636 | ;; reselect the outside window only. | |
2637 | ;; Only needed if we are not recovering windows?? | |
2638 | (if (edebug-window-live-p edebug-outside-window) | |
2639 | (select-window edebug-outside-window)) | |
2640 | ) ; if edebug-save-windows | |
2641 | ||
2642 | ;; Restore current buffer always, in case application needs it. | |
57577884 RS |
2643 | (if (buffer-name edebug-outside-buffer) |
2644 | (set-buffer edebug-outside-buffer)) | |
88668147 | 2645 | ;; Restore point, and mark. |
1fe3d507 | 2646 | ;; Needed even if restoring windows because |
f7359658 RS |
2647 | ;; that doesn't restore point and mark in the current buffer. |
2648 | ;; But don't restore point if edebug-buffer is current buffer. | |
88668147 DL |
2649 | (if (not (eq edebug-buffer edebug-outside-buffer)) |
2650 | (goto-char edebug-outside-point)) | |
2651 | (if (marker-buffer (edebug-mark-marker)) | |
2652 | ;; Does zmacs-regions need to be nil while doing set-marker? | |
2653 | (set-marker (edebug-mark-marker) edebug-outside-mark)) | |
2654 | ) ; unwind-protect | |
2655 | ;; None of the following is done if quit or signal occurs. | |
2656 | ||
2657 | ;; Restore edebug-buffer's outside point. | |
a1506d29 | 2658 | ;; (edebug-trace "restore edebug-buffer point: %s" |
88668147 | 2659 | ;; edebug-buffer-outside-point) |
de70529f SM |
2660 | (with-current-buffer edebug-buffer |
2661 | (goto-char edebug-buffer-outside-point)) | |
88668147 DL |
2662 | ;; ... nothing more. |
2663 | ) | |
2de39f08 SM |
2664 | ;; Could be an option to keep eval display up. |
2665 | (if edebug-eval-buffer (kill-buffer edebug-eval-buffer)) | |
3cc9e6d8 | 2666 | (with-timeout-unsuspend edebug-with-timeout-suspend) |
88668147 DL |
2667 | ;; Reset global variables to outside values in case they were changed. |
2668 | (setq | |
3a799327 | 2669 | unread-command-events edebug-outside-unread-command-events |
88668147 DL |
2670 | overlay-arrow-position edebug-outside-o-a-p |
2671 | overlay-arrow-string edebug-outside-o-a-s | |
de70529f SM |
2672 | cursor-in-echo-area edebug-outside-c-i-e-a) |
2673 | (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) | |
88668147 | 2674 | ))) |
1fe3d507 | 2675 | |
84fc2cfa | 2676 | |
1fe3d507 DL |
2677 | (defvar edebug-number-of-recursions 0) |
2678 | ;; Number of recursive edits started by edebug. | |
2679 | ;; Should be 0 at the top level. | |
2680 | ||
2681 | (defvar edebug-recursion-depth 0) | |
2682 | ;; Value of recursion-depth when edebug was called. | |
2683 | ||
2684 | ;; Dynamically declared unbound vars | |
2685 | (defvar edebug-outside-match-data) ; match data outside of edebug | |
2686 | (defvar edebug-backtrace-buffer) ; each recursive edit gets its own | |
a1506d29 | 2687 | (defvar edebug-inside-windows) |
1fe3d507 DL |
2688 | (defvar edebug-interactive-p) |
2689 | ||
2690 | (defvar edebug-outside-map) | |
2691 | (defvar edebug-outside-standard-output) | |
2692 | (defvar edebug-outside-standard-input) | |
c820ffeb | 2693 | (defvar edebug-outside-current-prefix-arg) |
1fe3d507 DL |
2694 | (defvar edebug-outside-last-command) |
2695 | (defvar edebug-outside-this-command) | |
1fe3d507 | 2696 | |
100aa77c RS |
2697 | ;; Note: here we have defvars for variables that are |
2698 | ;; built-in in certain versions. | |
2699 | ;; Each defvar makes a difference | |
2700 | ;; in versions where the variable is *not* built-in. | |
2701 | ||
1e46f9e4 | 2702 | ;; Emacs 18 FIXME |
1fe3d507 | 2703 | |
1fe3d507 DL |
2704 | ;; Emacs 19. |
2705 | (defvar edebug-outside-last-command-event) | |
1fe3d507 DL |
2706 | (defvar edebug-outside-last-input-event) |
2707 | (defvar edebug-outside-last-event-frame) | |
2708 | (defvar edebug-outside-last-nonmenu-event) | |
2709 | (defvar edebug-outside-track-mouse) | |
2710 | ||
bd8d6108 | 2711 | (defun edebug--recursive-edit (arg-mode) |
1fe3d507 | 2712 | ;; Start up a recursive edit inside of edebug. |
84fc2cfa | 2713 | ;; The current buffer is the edebug-buffer, which is put into edebug-mode. |
1fe3d507 | 2714 | ;; Assume that none of the variables below are buffer-local. |
17c781d1 | 2715 | (let (;; match-data must be done in the outside buffer |
84fc2cfa | 2716 | (edebug-outside-match-data |
de70529f | 2717 | (with-current-buffer edebug-outside-buffer ; in case match buffer different |
84fc2cfa ER |
2718 | (match-data))) |
2719 | ||
1fe3d507 | 2720 | ;;(edebug-number-of-recursions (1+ edebug-number-of-recursions)) |
84fc2cfa ER |
2721 | (edebug-recursion-depth (recursion-depth)) |
2722 | edebug-entered ; bind locally to nil | |
1fe3d507 | 2723 | (edebug-interactive-p nil) ; again non-interactive |
84fc2cfa ER |
2724 | edebug-backtrace-buffer ; each recursive edit gets its own |
2725 | ;; The window configuration may be saved and restored | |
2726 | ;; during a recursive-edit | |
2727 | edebug-inside-windows | |
2728 | ||
60c49c0f SM |
2729 | ;; Save the outside value of executing macro. (here??) |
2730 | (edebug-outside-executing-macro executing-kbd-macro) | |
2731 | (edebug-outside-pre-command-hook | |
2732 | (edebug-var-status 'pre-command-hook)) | |
2733 | (edebug-outside-post-command-hook | |
2734 | (edebug-var-status 'post-command-hook)) | |
2735 | ||
2736 | (edebug-outside-standard-output standard-output) | |
84fc2cfa | 2737 | (edebug-outside-standard-input standard-input) |
88668147 | 2738 | (edebug-outside-defining-kbd-macro defining-kbd-macro) |
84fc2cfa | 2739 | |
84fc2cfa ER |
2740 | (edebug-outside-last-command last-command) |
2741 | (edebug-outside-this-command this-command) | |
1fe3d507 | 2742 | |
c820ffeb | 2743 | (edebug-outside-current-prefix-arg current-prefix-arg) |
1fe3d507 DL |
2744 | |
2745 | (edebug-outside-last-input-event last-input-event) | |
2746 | (edebug-outside-last-command-event last-command-event) | |
1fe3d507 DL |
2747 | (edebug-outside-last-event-frame last-event-frame) |
2748 | (edebug-outside-last-nonmenu-event last-nonmenu-event) | |
2749 | (edebug-outside-track-mouse track-mouse) | |
84fc2cfa ER |
2750 | ) |
2751 | ||
84fc2cfa | 2752 | (unwind-protect |
88668147 DL |
2753 | (let ( |
2754 | ;; Declare global values local but using the same global value. | |
2755 | ;; We could set these to the values for previous edebug call. | |
a1506d29 | 2756 | (last-command last-command) |
88668147 | 2757 | (this-command this-command) |
c820ffeb | 2758 | (current-prefix-arg nil) |
88668147 DL |
2759 | |
2760 | ;; More for Emacs 19 | |
2761 | (last-input-event nil) | |
2762 | (last-command-event nil) | |
88668147 DL |
2763 | (last-event-frame nil) |
2764 | (last-nonmenu-event nil) | |
2765 | (track-mouse nil) | |
2766 | ||
2de39f08 SM |
2767 | (standard-output t) |
2768 | (standard-input t) | |
2769 | ||
60c49c0f SM |
2770 | ;; Don't keep reading from an executing kbd macro |
2771 | ;; within edebug unless edebug-continue-kbd-macro is | |
2772 | ;; non-nil. Again, local binding may not be best. | |
2773 | (executing-kbd-macro | |
2774 | (if edebug-continue-kbd-macro executing-kbd-macro)) | |
2775 | ||
2776 | ;; Don't get confused by the user's keymap changes. | |
2777 | (overriding-local-map nil) | |
2778 | (overriding-terminal-local-map nil) | |
2779 | ||
2780 | ;; Bind again to outside values. | |
88668147 DL |
2781 | (debug-on-error edebug-outside-debug-on-error) |
2782 | (debug-on-quit edebug-outside-debug-on-quit) | |
2783 | ||
2784 | ;; Don't keep defining a kbd macro. | |
a1506d29 | 2785 | (defining-kbd-macro |
88668147 DL |
2786 | (if edebug-continue-kbd-macro defining-kbd-macro)) |
2787 | ||
60c49c0f SM |
2788 | ;; Disable command hooks. This is essential when |
2789 | ;; a hook function is instrumented - to avoid infinite loop. | |
2790 | ;; This may be more than we need, however. | |
2791 | (pre-command-hook nil) | |
2792 | (post-command-hook nil) | |
2793 | ||
88668147 DL |
2794 | ;; others?? |
2795 | ) | |
2796 | ||
88668147 | 2797 | (if (and (eq edebug-execution-mode 'go) |
bd8d6108 | 2798 | (not (memq arg-mode '(after error)))) |
88668147 DL |
2799 | (message "Break")) |
2800 | ||
1e3ab67b | 2801 | (setq signal-hook-function nil) |
88668147 | 2802 | |
17c781d1 | 2803 | (edebug-mode 1) |
88668147 DL |
2804 | (unwind-protect |
2805 | (recursive-edit) ; <<<<<<<<<< Recursive edit | |
2806 | ||
2807 | ;; Do the following, even if quit occurs. | |
1e3ab67b | 2808 | (setq signal-hook-function 'edebug-signal) |
88668147 DL |
2809 | (if edebug-backtrace-buffer |
2810 | (kill-buffer edebug-backtrace-buffer)) | |
88668147 DL |
2811 | |
2812 | ;; Remember selected-window after recursive-edit. | |
2813 | ;; (setq edebug-inside-window (selected-window)) | |
2814 | ||
ccb61a97 | 2815 | (set-match-data edebug-outside-match-data) |
88668147 DL |
2816 | |
2817 | ;; Recursive edit may have changed buffers, | |
2818 | ;; so set it back before exiting let. | |
2819 | (if (buffer-name edebug-buffer) ; if it still exists | |
2820 | (progn | |
2821 | (set-buffer edebug-buffer) | |
2822 | (if (memq edebug-execution-mode '(go Go-nonstop)) | |
2823 | (edebug-overlay-arrow)) | |
17c781d1 | 2824 | (edebug-mode -1)) |
88668147 DL |
2825 | ;; gotta have a buffer to let its buffer local variables be set |
2826 | (get-buffer-create " bogus edebug buffer")) | |
2827 | ));; inner let | |
2828 | ||
2829 | ;; Reset global vars to outside values, in case they have been changed. | |
a1506d29 | 2830 | (setq |
88668147 DL |
2831 | last-command-event edebug-outside-last-command-event |
2832 | last-command edebug-outside-last-command | |
2833 | this-command edebug-outside-this-command | |
c820ffeb | 2834 | current-prefix-arg edebug-outside-current-prefix-arg |
88668147 DL |
2835 | last-input-event edebug-outside-last-input-event |
2836 | last-event-frame edebug-outside-last-event-frame | |
2837 | last-nonmenu-event edebug-outside-last-nonmenu-event | |
2838 | track-mouse edebug-outside-track-mouse | |
2839 | ||
2840 | standard-output edebug-outside-standard-output | |
2841 | standard-input edebug-outside-standard-input | |
60c49c0f SM |
2842 | defining-kbd-macro edebug-outside-defining-kbd-macro) |
2843 | ||
2844 | (setq executing-kbd-macro edebug-outside-executing-macro) | |
2845 | (edebug-restore-status | |
2846 | 'post-command-hook edebug-outside-post-command-hook) | |
2847 | (edebug-restore-status | |
2848 | 'pre-command-hook edebug-outside-pre-command-hook)))) | |
84fc2cfa | 2849 | |
1fe3d507 DL |
2850 | |
2851 | ;;; Display related functions | |
84fc2cfa ER |
2852 | |
2853 | (defun edebug-adjust-window (old-start) | |
1fe3d507 | 2854 | ;; If pos is not visible, adjust current window to fit following context. |
2de39f08 SM |
2855 | ;; (message "window: %s old-start: %s window-start: %s pos: %s" |
2856 | ;; (selected-window) old-start (window-start) (point)) (sit-for 5) | |
84fc2cfa ER |
2857 | (if (not (pos-visible-in-window-p)) |
2858 | (progn | |
1fe3d507 DL |
2859 | ;; First try old-start |
2860 | (if old-start | |
2861 | (set-window-start (selected-window) old-start)) | |
84fc2cfa | 2862 | (if (not (pos-visible-in-window-p)) |
1fe3d507 | 2863 | (progn |
2de39f08 | 2864 | ;; (message "resetting window start") (sit-for 2) |
1fe3d507 DL |
2865 | (set-window-start |
2866 | (selected-window) | |
2867 | (save-excursion | |
2868 | (forward-line | |
2869 | (if (< (point) (window-start)) -1 ; one line before if in back | |
2870 | (- (/ (window-height) 2)) ; center the line moving forward | |
2871 | )) | |
2872 | (beginning-of-line) | |
2873 | (point))))))) | |
84fc2cfa | 2874 | (window-start)) |
a1506d29 | 2875 | |
84fc2cfa ER |
2876 | |
2877 | ||
1fe3d507 DL |
2878 | (defconst edebug-arrow-alist |
2879 | '((Continue-fast . "=") | |
2880 | (Trace-fast . "-") | |
2881 | (continue . ">") | |
2882 | (trace . "->") | |
2883 | (step . "=>") | |
2884 | (next . "=>") | |
2885 | (go . "<>") | |
2886 | (Go-nonstop . "..") ; not used | |
2887 | ) | |
2888 | "Association list of arrows for each edebug mode.") | |
2889 | ||
2890 | (defun edebug-overlay-arrow () | |
2891 | ;; Set up the overlay arrow at beginning-of-line in current buffer. | |
a1506d29 | 2892 | ;; The arrow string is derived from edebug-arrow-alist and |
1fe3d507 | 2893 | ;; edebug-execution-mode. |
5ed619e0 | 2894 | (let ((pos (line-beginning-position))) |
1fe3d507 DL |
2895 | (setq overlay-arrow-string |
2896 | (cdr (assq edebug-execution-mode edebug-arrow-alist))) | |
2897 | (setq overlay-arrow-position (make-marker)) | |
2898 | (set-marker overlay-arrow-position pos (current-buffer)))) | |
84fc2cfa | 2899 | |
1fe3d507 DL |
2900 | |
2901 | (defun edebug-toggle-save-all-windows () | |
2902 | "Toggle the saving and restoring of all windows. | |
2903 | Also, each time you toggle it on, the inside and outside window | |
2904 | configurations become the same as the current configuration." | |
84fc2cfa | 2905 | (interactive) |
1fe3d507 DL |
2906 | (setq edebug-save-windows (not edebug-save-windows)) |
2907 | (if edebug-save-windows | |
84fc2cfa ER |
2908 | (setq edebug-inside-windows |
2909 | (setq edebug-outside-windows | |
1fe3d507 DL |
2910 | (edebug-current-windows |
2911 | edebug-save-windows)))) | |
2912 | (message "Window saving is %s for all windows." | |
84fc2cfa ER |
2913 | (if edebug-save-windows "on" "off"))) |
2914 | ||
1fe3d507 | 2915 | (defmacro edebug-changing-windows (&rest body) |
d8f1319a GM |
2916 | `(let ((window (selected-window))) |
2917 | (setq edebug-inside-windows (edebug-current-windows t)) | |
2918 | (edebug-set-windows edebug-outside-windows) | |
2919 | ,@body;; Code to change edebug-save-windows | |
a1506d29 | 2920 | (setq edebug-outside-windows (edebug-current-windows |
d8f1319a GM |
2921 | edebug-save-windows)) |
2922 | ;; Problem: what about outside windows that are deleted inside? | |
2923 | (edebug-set-windows edebug-inside-windows))) | |
1fe3d507 DL |
2924 | |
2925 | (defun edebug-toggle-save-selected-window () | |
a1506d29 | 2926 | "Toggle the saving and restoring of the selected window. |
1fe3d507 DL |
2927 | Also, each time you toggle it on, the inside and outside window |
2928 | configurations become the same as the current configuration." | |
2929 | (interactive) | |
2930 | (cond | |
2931 | ((eq t edebug-save-windows) | |
2932 | ;; Save all outside windows except the selected one. | |
2933 | ;; Remove (selected-window) from outside-windows. | |
2934 | (edebug-changing-windows | |
2935 | (setq edebug-save-windows (delq window (edebug-window-list))))) | |
2936 | ||
2937 | ((memq (selected-window) edebug-save-windows) | |
2938 | (setq edebug-outside-windows | |
2939 | (delq (assq (selected-window) edebug-outside-windows) | |
2940 | edebug-outside-windows)) | |
2941 | (setq edebug-save-windows | |
2942 | (delq (selected-window) edebug-save-windows))) | |
2943 | (t ; Save a new window. | |
2944 | (edebug-changing-windows | |
2945 | (setq edebug-save-windows (cons window edebug-save-windows))))) | |
2946 | ||
2947 | (message "Window saving is %s for %s." | |
2948 | (if (memq (selected-window) edebug-save-windows) | |
2949 | "on" "off") | |
2950 | (selected-window))) | |
2951 | ||
2952 | (defun edebug-toggle-save-windows (arg) | |
2953 | "Toggle the saving and restoring of windows. | |
2954 | With prefix, toggle for just the selected window. | |
2955 | Otherwise, toggle for all windows." | |
2956 | (interactive "P") | |
2957 | (if arg | |
2958 | (edebug-toggle-save-selected-window) | |
2959 | (edebug-toggle-save-all-windows))) | |
2960 | ||
84fc2cfa ER |
2961 | (defun edebug-where () |
2962 | "Show the debug windows and where we stopped in the program." | |
2963 | (interactive) | |
2964 | (if (not edebug-active) | |
1fe3d507 DL |
2965 | (error "Edebug is not active")) |
2966 | ;; Restore the window configuration to what it last was inside. | |
2967 | ;; But it is not always set. - experiment | |
2968 | ;;(if edebug-inside-windows | |
2969 | ;; (edebug-set-windows edebug-inside-windows)) | |
84fc2cfa | 2970 | (edebug-pop-to-buffer edebug-buffer) |
1fe3d507 | 2971 | (goto-char edebug-point)) |
84fc2cfa ER |
2972 | |
2973 | (defun edebug-view-outside () | |
1e46f9e4 GM |
2974 | "Change to the outside window configuration. |
2975 | Use `edebug-where' to return." | |
84fc2cfa ER |
2976 | (interactive) |
2977 | (if (not edebug-active) | |
1fe3d507 | 2978 | (error "Edebug is not active")) |
a1506d29 | 2979 | (setq edebug-inside-windows |
1fe3d507 DL |
2980 | (edebug-current-windows edebug-save-windows)) |
2981 | (edebug-set-windows edebug-outside-windows) | |
84fc2cfa | 2982 | (goto-char edebug-outside-point) |
1fe3d507 | 2983 | (message "Window configuration outside of Edebug. Return with %s" |
84fc2cfa ER |
2984 | (substitute-command-keys "\\<global-map>\\[edebug-where]"))) |
2985 | ||
2986 | ||
1fe3d507 DL |
2987 | (defun edebug-bounce-point (arg) |
2988 | "Bounce the point in the outside current buffer. | |
1e46f9e4 GM |
2989 | If prefix argument ARG is supplied, sit for that many seconds |
2990 | before returning. The default is one second." | |
1fe3d507 | 2991 | (interactive "p") |
84fc2cfa | 2992 | (if (not edebug-active) |
1fe3d507 | 2993 | (error "Edebug is not active")) |
84fc2cfa | 2994 | (save-excursion |
1fe3d507 | 2995 | ;; If the buffer's currently displayed, avoid set-window-configuration. |
84fc2cfa ER |
2996 | (save-window-excursion |
2997 | (edebug-pop-to-buffer edebug-outside-buffer) | |
84fc2cfa | 2998 | (goto-char edebug-outside-point) |
a1506d29 JB |
2999 | (message "Current buffer: %s Point: %s Mark: %s" |
3000 | (current-buffer) (point) | |
1fe3d507 DL |
3001 | (if (marker-buffer (edebug-mark-marker)) |
3002 | (marker-position (edebug-mark-marker)) "<not set>")) | |
2de39f08 | 3003 | (sit-for arg) |
1fe3d507 | 3004 | (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) |
84fc2cfa | 3005 | |
84fc2cfa | 3006 | |
a1506d29 | 3007 | ;; Joe Wells, here is a start at your idea of adding a buffer to the internal |
bd8d6108 | 3008 | ;; display list. Still need to use this list in edebug--display. |
84fc2cfa | 3009 | |
1fe3d507 DL |
3010 | '(defvar edebug-display-buffer-list nil |
3011 | "List of buffers that edebug will display when it is active.") | |
84fc2cfa | 3012 | |
1fe3d507 DL |
3013 | '(defun edebug-display-buffer (buffer) |
3014 | "Toggle display of a buffer inside of edebug." | |
3015 | (interactive "bBuffer: ") | |
3016 | (let ((already-displaying (memq buffer edebug-display-buffer-list))) | |
3017 | (setq edebug-display-buffer-list | |
3018 | (if already-displaying | |
3019 | (delq buffer edebug-display-buffer-list) | |
3020 | (cons buffer edebug-display-buffer-list))) | |
3021 | (message "Displaying %s %s" buffer | |
3022 | (if already-displaying "off" "on")))) | |
84fc2cfa | 3023 | |
1fe3d507 | 3024 | ;;; Breakpoint related functions |
84fc2cfa ER |
3025 | |
3026 | (defun edebug-find-stop-point () | |
1fe3d507 DL |
3027 | ;; Return (function . index) of the nearest edebug stop point. |
3028 | (let* ((edebug-def-name (edebug-form-data-symbol)) | |
84fc2cfa | 3029 | (edebug-data |
1fe3d507 DL |
3030 | (let ((data (get edebug-def-name 'edebug))) |
3031 | (if (or (null data) (markerp data)) | |
3032 | (error "%s is not instrumented for Edebug" edebug-def-name)) | |
3033 | data)) ; we could do it automatically, if data is a marker. | |
84fc2cfa | 3034 | ;; pull out parts of edebug-data. |
1fe3d507 DL |
3035 | (edebug-def-mark (car edebug-data)) |
3036 | ;; (edebug-breakpoints (car (cdr edebug-data))) | |
84fc2cfa | 3037 | |
1fe3d507 | 3038 | (offset-vector (nth 2 edebug-data)) |
84fc2cfa ER |
3039 | (offset (- (save-excursion |
3040 | (if (looking-at "[ \t]") | |
3041 | ;; skip backwards until non-whitespace, or bol | |
3042 | (skip-chars-backward " \t")) | |
3043 | (point)) | |
1fe3d507 | 3044 | edebug-def-mark)) |
84fc2cfa ER |
3045 | len i) |
3046 | ;; the offsets are in order so we can do a linear search | |
3047 | (setq len (length offset-vector)) | |
3048 | (setq i 0) | |
3049 | (while (and (< i len) (> offset (aref offset-vector i))) | |
3050 | (setq i (1+ i))) | |
3051 | (if (and (< i len) | |
3052 | (<= offset (aref offset-vector i))) | |
3053 | ;; return the relevant info | |
1fe3d507 | 3054 | (cons edebug-def-name i) |
84fc2cfa | 3055 | (message "Point is not on an expression in %s." |
1fe3d507 | 3056 | edebug-def-name) |
84fc2cfa ER |
3057 | ))) |
3058 | ||
3059 | ||
3060 | (defun edebug-next-breakpoint () | |
3061 | "Move point to the next breakpoint, or first if none past point." | |
3062 | (interactive) | |
3063 | (let ((edebug-stop-point (edebug-find-stop-point))) | |
3064 | (if edebug-stop-point | |
1fe3d507 | 3065 | (let* ((edebug-def-name (car edebug-stop-point)) |
84fc2cfa | 3066 | (index (cdr edebug-stop-point)) |
1fe3d507 | 3067 | (edebug-data (get edebug-def-name 'edebug)) |
a1506d29 | 3068 | |
84fc2cfa | 3069 | ;; pull out parts of edebug-data |
1fe3d507 | 3070 | (edebug-def-mark (car edebug-data)) |
84fc2cfa | 3071 | (edebug-breakpoints (car (cdr edebug-data))) |
1fe3d507 | 3072 | (offset-vector (nth 2 edebug-data)) |
84fc2cfa ER |
3073 | breakpoint) |
3074 | (if (not edebug-breakpoints) | |
3075 | (message "No breakpoints in this function.") | |
3076 | (let ((breaks edebug-breakpoints)) | |
3077 | (while (and breaks | |
3078 | (<= (car (car breaks)) index)) | |
3079 | (setq breaks (cdr breaks))) | |
3080 | (setq breakpoint | |
3081 | (if breaks | |
3082 | (car breaks) | |
3083 | ;; goto the first breakpoint | |
3084 | (car edebug-breakpoints))) | |
1fe3d507 | 3085 | (goto-char (+ edebug-def-mark |
84fc2cfa | 3086 | (aref offset-vector (car breakpoint)))) |
a1506d29 | 3087 | |
f7359658 RS |
3088 | (message "%s" |
3089 | (concat (if (nth 2 breakpoint) | |
84fc2cfa ER |
3090 | "Temporary " "") |
3091 | (if (car (cdr breakpoint)) | |
3092 | (format "Condition: %s" | |
1fe3d507 | 3093 | (edebug-safe-prin1-to-string |
84fc2cfa ER |
3094 | (car (cdr breakpoint)))) |
3095 | ""))) | |
3096 | )))))) | |
3097 | ||
3098 | ||
3099 | (defun edebug-modify-breakpoint (flag &optional condition temporary) | |
b6386e63 LT |
3100 | "Modify the breakpoint for the form at point or after it. |
3101 | Set it if FLAG is non-nil, clear it otherwise. Then move to that point. | |
84fc2cfa | 3102 | If CONDITION or TEMPORARY are non-nil, add those attributes to |
9854542e | 3103 | the breakpoint." |
84fc2cfa ER |
3104 | (let ((edebug-stop-point (edebug-find-stop-point))) |
3105 | (if edebug-stop-point | |
1fe3d507 | 3106 | (let* ((edebug-def-name (car edebug-stop-point)) |
84fc2cfa | 3107 | (index (cdr edebug-stop-point)) |
1fe3d507 | 3108 | (edebug-data (get edebug-def-name 'edebug)) |
a1506d29 | 3109 | |
84fc2cfa | 3110 | ;; pull out parts of edebug-data |
1fe3d507 | 3111 | (edebug-def-mark (car edebug-data)) |
84fc2cfa | 3112 | (edebug-breakpoints (car (cdr edebug-data))) |
1fe3d507 | 3113 | (offset-vector (nth 2 edebug-data)) |
84fc2cfa ER |
3114 | present) |
3115 | ;; delete it either way | |
3116 | (setq present (assq index edebug-breakpoints)) | |
3117 | (setq edebug-breakpoints (delq present edebug-breakpoints)) | |
3118 | (if flag | |
3119 | (progn | |
3120 | ;; add it to the list and resort | |
3121 | (setq edebug-breakpoints | |
3122 | (edebug-sort-alist | |
3123 | (cons | |
3124 | (list index condition temporary) | |
3125 | edebug-breakpoints) '<)) | |
1fe3d507 DL |
3126 | (if condition |
3127 | (message "Breakpoint set in %s with condition: %s" | |
3128 | edebug-def-name condition) | |
3129 | (message "Breakpoint set in %s" edebug-def-name))) | |
84fc2cfa | 3130 | (if present |
1fe3d507 DL |
3131 | (message "Breakpoint unset in %s" edebug-def-name) |
3132 | (message "No breakpoint here"))) | |
a1506d29 | 3133 | |
1fe3d507 DL |
3134 | (setcar (cdr edebug-data) edebug-breakpoints) |
3135 | (goto-char (+ edebug-def-mark (aref offset-vector index))) | |
84fc2cfa ER |
3136 | )))) |
3137 | ||
3138 | (defun edebug-set-breakpoint (arg) | |
3139 | "Set the breakpoint of nearest sexp. | |
3140 | With prefix argument, make it a temporary breakpoint." | |
3141 | (interactive "P") | |
3142 | (edebug-modify-breakpoint t nil arg)) | |
3143 | ||
3144 | (defun edebug-unset-breakpoint () | |
3145 | "Clear the breakpoint of nearest sexp." | |
3146 | (interactive) | |
3147 | (edebug-modify-breakpoint nil)) | |
3148 | ||
1fe3d507 | 3149 | |
1fe3d507 | 3150 | (defun edebug-set-global-break-condition (expression) |
1e46f9e4 | 3151 | "Set `edebug-global-break-condition' to EXPRESSION." |
20c78df0 JL |
3152 | (interactive |
3153 | (list | |
3154 | (let ((initial (and edebug-global-break-condition | |
3155 | (format "%s" edebug-global-break-condition)))) | |
3156 | (read-from-minibuffer | |
3157 | "Global Condition: " initial read-expression-map t | |
3158 | (if (equal (car read-expression-history) initial) | |
3159 | '(read-expression-history . 1) | |
3160 | 'read-expression-history))))) | |
1fe3d507 DL |
3161 | (setq edebug-global-break-condition expression)) |
3162 | ||
3163 | ||
3164 | ;;; Mode switching functions | |
84fc2cfa ER |
3165 | |
3166 | (defun edebug-set-mode (mode shortmsg msg) | |
1fe3d507 DL |
3167 | ;; Set the edebug mode to MODE. |
3168 | ;; Display SHORTMSG, or MSG if not within edebug. | |
3169 | (if (eq (1+ edebug-recursion-depth) (recursion-depth)) | |
3170 | (progn | |
3171 | (setq edebug-execution-mode mode) | |
274f1353 | 3172 | (message "%s" shortmsg) |
1fe3d507 DL |
3173 | ;; Continue execution |
3174 | (exit-recursive-edit)) | |
3175 | ;; This is not terribly useful!! | |
3176 | (setq edebug-next-execution-mode mode) | |
274f1353 | 3177 | (message "%s" msg))) |
84fc2cfa ER |
3178 | |
3179 | ||
1fe3d507 DL |
3180 | (defalias 'edebug-step-through-mode 'edebug-step-mode) |
3181 | ||
3182 | (defun edebug-step-mode () | |
3183 | "Proceed to next stop point." | |
3184 | (interactive) | |
3185 | (edebug-set-mode 'step "" "Edebug will stop at next stop point.")) | |
3186 | ||
3187 | (defun edebug-next-mode () | |
3188 | "Proceed to next `after' stop point." | |
84fc2cfa | 3189 | (interactive) |
1fe3d507 | 3190 | (edebug-set-mode 'next "" "Edebug will stop after next eval.")) |
84fc2cfa | 3191 | |
1fe3d507 | 3192 | (defun edebug-go-mode (arg) |
84fc2cfa | 3193 | "Go, evaluating until break. |
1fe3d507 | 3194 | With prefix ARG, set temporary break at current point and go." |
84fc2cfa ER |
3195 | (interactive "P") |
3196 | (if arg | |
3197 | (edebug-set-breakpoint t)) | |
1fe3d507 | 3198 | (edebug-set-mode 'go "Go..." "Edebug will go until break.")) |
84fc2cfa | 3199 | |
1fe3d507 | 3200 | (defun edebug-Go-nonstop-mode () |
1e46f9e4 GM |
3201 | "Go, evaluating without debugging. |
3202 | You can use `edebug-stop', or any editing command, to stop." | |
84fc2cfa ER |
3203 | (interactive) |
3204 | (edebug-set-mode 'Go-nonstop "Go-Nonstop..." | |
1fe3d507 DL |
3205 | "Edebug will not stop at breaks.")) |
3206 | ||
3207 | ||
3208 | (defun edebug-trace-mode () | |
1e46f9e4 GM |
3209 | "Begin trace mode. |
3210 | Pauses for `edebug-sit-for-seconds' at each stop point." | |
1fe3d507 DL |
3211 | (interactive) |
3212 | (edebug-set-mode 'trace "Tracing..." "Edebug will trace with pause.")) | |
3213 | ||
3214 | (defun edebug-Trace-fast-mode () | |
1e46f9e4 GM |
3215 | "Trace with no wait at each step. |
3216 | Updates the display at each stop point, but does not pause." | |
1fe3d507 DL |
3217 | (interactive) |
3218 | (edebug-set-mode 'Trace-fast | |
3219 | "Trace fast..." "Edebug will trace without pause.")) | |
3220 | ||
3221 | (defun edebug-continue-mode () | |
1e46f9e4 GM |
3222 | "Begin continue mode. |
3223 | Pauses for `edebug-sit-for-seconds' at each break point." | |
1fe3d507 DL |
3224 | (interactive) |
3225 | (edebug-set-mode 'continue "Continue..." | |
3226 | "Edebug will pause at breakpoints.")) | |
3227 | ||
3228 | (defun edebug-Continue-fast-mode () | |
1e46f9e4 GM |
3229 | "Trace with no wait at each step. |
3230 | Updates the display at each break point, but does not pause." | |
1fe3d507 DL |
3231 | (interactive) |
3232 | (edebug-set-mode 'Continue-fast "Continue fast..." | |
3233 | "Edebug will stop and go at breakpoints.")) | |
3234 | ||
3235 | ;; ------------------------------------------------------------ | |
3236 | ;; The following use the mode changing commands and breakpoints. | |
3237 | ||
3238 | ||
3239 | (defun edebug-goto-here () | |
8a33e9f1 | 3240 | "Proceed to first stop-point at or after current position of point." |
1fe3d507 DL |
3241 | (interactive) |
3242 | (edebug-go-mode t)) | |
3243 | ||
3244 | ||
3245 | (defun edebug-stop () | |
3246 | "Stop execution and do not continue. | |
3247 | Useful for exiting from trace or continue loop." | |
3248 | (interactive) | |
3249 | (message "Stop")) | |
3250 | ||
3251 | ||
3252 | '(defun edebug-forward () | |
3253 | "Proceed to the exit of the next expression to be evaluated." | |
3254 | (interactive) | |
a1506d29 | 3255 | (edebug-set-mode |
1fe3d507 DL |
3256 | 'forward "Forward" |
3257 | "Edebug will stop after exiting the next expression.")) | |
3258 | ||
84fc2cfa ER |
3259 | |
3260 | (defun edebug-forward-sexp (arg) | |
3261 | "Proceed from the current point to the end of the ARGth sexp ahead. | |
1e46f9e4 | 3262 | If there are not ARG sexps ahead, then do `edebug-step-out'." |
84fc2cfa | 3263 | (interactive "p") |
1fe3d507 | 3264 | (condition-case nil |
84fc2cfa ER |
3265 | (let ((parse-sexp-ignore-comments t)) |
3266 | ;; Call forward-sexp repeatedly until done or failure. | |
3267 | (forward-sexp arg) | |
1fe3d507 | 3268 | (edebug-go-mode t)) |
84fc2cfa ER |
3269 | (error |
3270 | (edebug-step-out) | |
3271 | ))) | |
3272 | ||
3273 | (defun edebug-step-out () | |
3274 | "Proceed from the current point to the end of the containing sexp. | |
3275 | If there is no containing sexp that is not the top level defun, | |
3276 | go to the end of the last sexp, or if that is the same point, then step." | |
3277 | (interactive) | |
1fe3d507 | 3278 | (condition-case nil |
84fc2cfa ER |
3279 | (let ((parse-sexp-ignore-comments t)) |
3280 | (up-list 1) | |
3281 | (save-excursion | |
3282 | ;; Is there still a containing expression? | |
3283 | (up-list 1)) | |
1fe3d507 | 3284 | (edebug-go-mode t)) |
84fc2cfa ER |
3285 | (error |
3286 | ;; At top level - 1, so first check if there are more sexps at this level. | |
3287 | (let ((start-point (point))) | |
3288 | ;; (up-list 1) | |
3289 | (down-list -1) | |
3290 | (if (= (point) start-point) | |
1fe3d507 DL |
3291 | (edebug-step-mode) ; No more at this level, so step. |
3292 | (edebug-go-mode t) | |
84fc2cfa ER |
3293 | ))))) |
3294 | ||
1fe3d507 DL |
3295 | (defun edebug-instrument-function (func) |
3296 | ;; Func should be a function symbol. | |
3297 | ;; Return the function symbol, or nil if not instrumented. | |
3ebb8416 | 3298 | (let ((func-marker (get func 'edebug))) |
1fe3d507 | 3299 | (cond |
49ffc078 | 3300 | ((and (markerp func-marker) (marker-buffer func-marker)) |
1fe3d507 | 3301 | ;; It is uninstrumented, so instrument it. |
3ebb8416 | 3302 | (with-current-buffer (marker-buffer func-marker) |
1fe3d507 DL |
3303 | (goto-char func-marker) |
3304 | (edebug-eval-top-level-form) | |
3305 | func)) | |
3306 | ((consp func-marker) | |
3307 | (message "%s is already instrumented." func) | |
3308 | func) | |
3ebb8416 | 3309 | (t |
23a8a5ab | 3310 | (let ((loc (find-function-noselect func t))) |
fea7b514 RS |
3311 | (unless (cdr loc) |
3312 | (error "Could not find the definition in its file")) | |
3ebb8416 SM |
3313 | (with-current-buffer (car loc) |
3314 | (goto-char (cdr loc)) | |
3315 | (edebug-eval-top-level-form) | |
3316 | func)))))) | |
1fe3d507 DL |
3317 | |
3318 | (defun edebug-instrument-callee () | |
a1506d29 | 3319 | "Instrument the definition of the function or macro about to be called. |
1fe3d507 DL |
3320 | Do this when stopped before the form or it will be too late. |
3321 | One side effect of using this command is that the next time the | |
3322 | function or macro is called, Edebug will be called there as well." | |
84fc2cfa | 3323 | (interactive) |
1fe3d507 DL |
3324 | (if (not (looking-at "\(")) |
3325 | (error "You must be before a list form") | |
3326 | (let ((func | |
3327 | (save-excursion | |
3328 | (down-list 1) | |
3329 | (if (looking-at "\(") | |
2de39f08 | 3330 | (edebug--form-data-name |
1fe3d507 | 3331 | (edebug-get-form-data-entry (point))) |
88668147 | 3332 | (edebug-original-read (current-buffer)))))) |
1fe3d507 | 3333 | (edebug-instrument-function func)))) |
84fc2cfa | 3334 | |
84fc2cfa | 3335 | |
1fe3d507 | 3336 | (defun edebug-step-in () |
a1506d29 JB |
3337 | "Step into the definition of the function or macro about to be called. |
3338 | This first does `edebug-instrument-callee' to ensure that it is | |
1fe3d507 | 3339 | instrumented. Then it does `edebug-on-entry' and switches to `go' mode." |
84fc2cfa | 3340 | (interactive) |
1fe3d507 DL |
3341 | (let ((func (edebug-instrument-callee))) |
3342 | (if func | |
3343 | (progn | |
3344 | (edebug-on-entry func 'temp) | |
3345 | (edebug-go-mode nil))))) | |
84fc2cfa | 3346 | |
1fe3d507 DL |
3347 | (defun edebug-on-entry (function &optional flag) |
3348 | "Cause Edebug to stop when FUNCTION is called. | |
3349 | With prefix argument, make this temporary so it is automatically | |
c80e3b4a | 3350 | canceled the first time the function is entered." |
1fe3d507 DL |
3351 | (interactive "aEdebug on entry to: \nP") |
3352 | ;; Could store this in the edebug data instead. | |
3353 | (put function 'edebug-on-entry (if flag 'temp t))) | |
84fc2cfa | 3354 | |
1fe3d507 DL |
3355 | (defun cancel-edebug-on-entry (function) |
3356 | (interactive "aEdebug on entry to: ") | |
3357 | (put function 'edebug-on-entry nil)) | |
84fc2cfa | 3358 | |
a1506d29 | 3359 | |
88668147 DL |
3360 | (if (not (fboundp 'edebug-original-debug-on-entry)) |
3361 | (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry))) | |
1fe3d507 DL |
3362 | '(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this? |
3363 | ;; Also need edebug-cancel-debug-on-entry | |
3364 | ||
3365 | '(defun edebug-debug-on-entry (function) | |
3366 | "Request FUNCTION to invoke debugger each time it is called. | |
3367 | If the user continues, FUNCTION's execution proceeds. | |
3368 | Works by modifying the definition of FUNCTION, | |
3369 | which must be written in Lisp, not predefined. | |
3370 | Use `cancel-debug-on-entry' to cancel the effect of this command. | |
3371 | Redefining FUNCTION also does that. | |
3372 | ||
3373 | This version is from Edebug. If the function is instrumented for | |
6db746da | 3374 | Edebug, it calls `edebug-on-entry'." |
1fe3d507 DL |
3375 | (interactive "aDebug on entry (to function): ") |
3376 | (let ((func-data (get function 'edebug))) | |
3377 | (if (or (null func-data) (markerp func-data)) | |
88668147 | 3378 | (edebug-original-debug-on-entry function) |
1fe3d507 DL |
3379 | (edebug-on-entry function)))) |
3380 | ||
3381 | ||
3382 | (defun edebug-top-level-nonstop () | |
3383 | "Set mode to Go-nonstop, and exit to top-level. | |
242b1f68 | 3384 | This is useful for exiting even if `unwind-protect' code may be executed." |
84fc2cfa | 3385 | (interactive) |
1fe3d507 DL |
3386 | (setq edebug-execution-mode 'Go-nonstop) |
3387 | (top-level)) | |
84fc2cfa ER |
3388 | |
3389 | ||
3390 | ;;(defun edebug-exit-out () | |
3391 | ;; "Go until the current function exits." | |
3392 | ;; (interactive) | |
3393 | ;; (edebug-set-mode 'exiting "Exit...")) | |
3394 | ||
3395 | ||
84fc2cfa ER |
3396 | ;;; The following initial mode setting definitions are not used yet. |
3397 | ||
1fe3d507 | 3398 | '(defconst edebug-initial-mode-alist |
84fc2cfa ER |
3399 | '((edebug-Continue-fast . Continue-fast) |
3400 | (edebug-Trace-fast . Trace-fast) | |
3401 | (edebug-continue . continue) | |
3402 | (edebug-trace . trace) | |
3403 | (edebug-go . go) | |
3404 | (edebug-step-through . step) | |
3405 | (edebug-Go-nonstop . Go-nonstop) | |
3406 | ) | |
3407 | "Association list between commands and the modes they set.") | |
3408 | ||
3409 | ||
1fe3d507 | 3410 | '(defun edebug-set-initial-mode () |
84fc2cfa ER |
3411 | "Ask for the initial mode of the enclosing function. |
3412 | The mode is requested via the key that would be used to set the mode in | |
3413 | edebug-mode." | |
3414 | (interactive) | |
3415 | (let* ((this-function (edebug-which-function)) | |
3416 | (keymap (if (eq edebug-mode-map (current-local-map)) | |
3417 | edebug-mode-map)) | |
3418 | (old-mode (or (get this-function 'edebug-initial-mode) | |
3419 | edebug-initial-mode)) | |
3420 | (key (read-key-sequence | |
3421 | (format | |
3422 | "Change initial edebug mode for %s from %s (%s) to (enter key): " | |
3423 | this-function | |
3424 | old-mode | |
3425 | (where-is-internal | |
3426 | (car (rassq old-mode edebug-initial-mode-alist)) | |
3427 | keymap 'firstonly | |
3428 | )))) | |
3429 | (mode (cdr (assq (key-binding key) edebug-initial-mode-alist))) | |
3430 | ) | |
3431 | (if (and mode | |
3432 | (or (get this-function 'edebug-initial-mode) | |
3433 | (not (eq mode edebug-initial-mode)))) | |
3434 | (progn | |
3435 | (put this-function 'edebug-initial-mode mode) | |
3436 | (message "Initial mode for %s is now: %s" | |
3437 | this-function mode)) | |
4897b0a0 | 3438 | (error "Key must map to one of the mode changing commands") |
84fc2cfa ER |
3439 | ))) |
3440 | ||
1fe3d507 | 3441 | ;;; Evaluation of expressions |
84fc2cfa | 3442 | |
1fe3d507 DL |
3443 | (defmacro edebug-outside-excursion (&rest body) |
3444 | "Evaluate an expression list in the outside context. | |
3445 | Return the result of the last expression." | |
bd8d6108 | 3446 | (declare (debug t)) |
d8f1319a GM |
3447 | `(save-excursion ; of current-buffer |
3448 | (if edebug-save-windows | |
3449 | (progn | |
a1506d29 | 3450 | ;; After excursion, we will |
d8f1319a GM |
3451 | ;; restore to current window configuration. |
3452 | (setq edebug-inside-windows | |
3453 | (edebug-current-windows edebug-save-windows)) | |
3454 | ;; Restore outside windows. | |
3455 | (edebug-set-windows edebug-outside-windows))) | |
3456 | ||
3457 | (set-buffer edebug-buffer) ; why? | |
3458 | ;; (use-local-map edebug-outside-map) | |
3459 | (set-match-data edebug-outside-match-data) | |
3460 | ;; Restore outside context. | |
3461 | (let (;; (edebug-inside-map (current-local-map)) ;; restore map?? | |
d8f1319a GM |
3462 | (last-command-event edebug-outside-last-command-event) |
3463 | (last-command edebug-outside-last-command) | |
3464 | (this-command edebug-outside-this-command) | |
d8f1319a GM |
3465 | (unread-command-events edebug-outside-unread-command-events) |
3466 | (current-prefix-arg edebug-outside-current-prefix-arg) | |
d8f1319a GM |
3467 | (last-input-event edebug-outside-last-input-event) |
3468 | (last-event-frame edebug-outside-last-event-frame) | |
3469 | (last-nonmenu-event edebug-outside-last-nonmenu-event) | |
3470 | (track-mouse edebug-outside-track-mouse) | |
3471 | (standard-output edebug-outside-standard-output) | |
3472 | (standard-input edebug-outside-standard-input) | |
3473 | ||
3474 | (executing-kbd-macro edebug-outside-executing-macro) | |
3475 | (defining-kbd-macro edebug-outside-defining-kbd-macro) | |
5fc58d83 RS |
3476 | ;; Get the values out of the saved statuses. |
3477 | (pre-command-hook (cdr edebug-outside-pre-command-hook)) | |
3478 | (post-command-hook (cdr edebug-outside-post-command-hook)) | |
d8f1319a | 3479 | |
bd8d6108 | 3480 | ;; See edebug-display. |
d8f1319a GM |
3481 | (overlay-arrow-position edebug-outside-o-a-p) |
3482 | (overlay-arrow-string edebug-outside-o-a-s) | |
3483 | (cursor-in-echo-area edebug-outside-c-i-e-a) | |
3484 | ) | |
de70529f | 3485 | (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) |
d8f1319a | 3486 | (unwind-protect |
9a529312 | 3487 | (with-current-buffer edebug-outside-buffer ; of edebug-buffer |
d8f1319a GM |
3488 | (goto-char edebug-outside-point) |
3489 | (if (marker-buffer (edebug-mark-marker)) | |
3490 | (set-marker (edebug-mark-marker) edebug-outside-mark)) | |
3491 | ,@body) | |
3492 | ||
3493 | ;; Back to edebug-buffer. Restore rest of inside context. | |
3494 | ;; (use-local-map edebug-inside-map) | |
3495 | (if edebug-save-windows | |
3496 | ;; Restore inside windows. | |
3497 | (edebug-set-windows edebug-inside-windows)) | |
3498 | ||
3499 | ;; Save values that may have been changed. | |
a1506d29 | 3500 | (setq |
d8f1319a GM |
3501 | edebug-outside-last-command-event last-command-event |
3502 | edebug-outside-last-command last-command | |
3503 | edebug-outside-this-command this-command | |
d8f1319a GM |
3504 | edebug-outside-unread-command-events unread-command-events |
3505 | edebug-outside-current-prefix-arg current-prefix-arg | |
d8f1319a GM |
3506 | edebug-outside-last-input-event last-input-event |
3507 | edebug-outside-last-event-frame last-event-frame | |
3508 | edebug-outside-last-nonmenu-event last-nonmenu-event | |
3509 | edebug-outside-track-mouse track-mouse | |
3510 | edebug-outside-standard-output standard-output | |
3511 | edebug-outside-standard-input standard-input | |
3512 | ||
3513 | edebug-outside-executing-macro executing-kbd-macro | |
3514 | edebug-outside-defining-kbd-macro defining-kbd-macro | |
d8f1319a GM |
3515 | |
3516 | edebug-outside-o-a-p overlay-arrow-position | |
3517 | edebug-outside-o-a-s overlay-arrow-string | |
3518 | edebug-outside-c-i-e-a cursor-in-echo-area | |
de70529f SM |
3519 | edebug-outside-d-c-i-n-s-w (default-value |
3520 | 'cursor-in-non-selected-windows) | |
3521 | ) | |
5fc58d83 RS |
3522 | |
3523 | ;; Restore the outside saved values; don't alter | |
3524 | ;; the outside binding loci. | |
3525 | (setcdr edebug-outside-pre-command-hook pre-command-hook) | |
3526 | (setcdr edebug-outside-post-command-hook post-command-hook) | |
3527 | ||
de70529f | 3528 | (setq-default cursor-in-non-selected-windows t) |
5fc58d83 | 3529 | )) ; let |
d8f1319a | 3530 | )) |
1fe3d507 | 3531 | |
08ee6200 | 3532 | (defvar cl-debug-env) ; defined in cl; non-nil when lexical env used. |
1fe3d507 | 3533 | |
bd8d6108 | 3534 | (defun edebug-eval (expr) |
1fe3d507 | 3535 | ;; Are there cl lexical variables active? |
2de39f08 SM |
3536 | (eval (if (and (bound-and-true-p cl-debug-env) |
3537 | (fboundp 'cl-macroexpand-all)) | |
bd8d6108 SM |
3538 | (cl-macroexpand-all expr cl-debug-env) |
3539 | expr) | |
7200d79c | 3540 | lexical-binding)) |
1fe3d507 | 3541 | |
bd8d6108 | 3542 | (defun edebug-safe-eval (expr) |
a1506d29 | 3543 | ;; Evaluate EXPR safely. |
1fe3d507 DL |
3544 | ;; If there is an error, a string is returned describing the error. |
3545 | (condition-case edebug-err | |
bd8d6108 | 3546 | (edebug-eval expr) |
a1506d29 | 3547 | (error (edebug-format "%s: %s" ;; could |
1fe3d507 DL |
3548 | (get (car edebug-err) 'error-message) |
3549 | (car (cdr edebug-err)))))) | |
3550 | ||
f7359658 RS |
3551 | ;;; Printing |
3552 | ||
1fe3d507 | 3553 | |
bd8d6108 | 3554 | (defun edebug-report-error (value) |
1fe3d507 DL |
3555 | ;; Print an error message like command level does. |
3556 | ;; This also prints the error name if it has no error-message. | |
a1506d29 | 3557 | (message "%s: %s" |
bd8d6108 SM |
3558 | (or (get (car value) 'error-message) |
3559 | (format "peculiar error (%s)" (car value))) | |
a1506d29 | 3560 | (mapconcat (function (lambda (edebug-arg) |
1fe3d507 DL |
3561 | ;; continuing after an error may |
3562 | ;; complain about edebug-arg. why?? | |
3563 | (prin1-to-string edebug-arg))) | |
bd8d6108 | 3564 | (cdr value) ", "))) |
1fe3d507 | 3565 | |
08ee6200 | 3566 | (defvar print-readably) ; defined by lemacs |
a1506d29 | 3567 | ;; Alternatively, we could change the definition of |
88668147 | 3568 | ;; edebug-safe-prin1-to-string to only use these if defined. |
1fe3d507 DL |
3569 | |
3570 | (defun edebug-safe-prin1-to-string (value) | |
84fc2cfa | 3571 | (let ((print-escape-newlines t) |
1fe3d507 DL |
3572 | (print-length (or edebug-print-length print-length)) |
3573 | (print-level (or edebug-print-level print-level)) | |
3574 | (print-circle (or edebug-print-circle print-circle)) | |
08ee6200 | 3575 | (print-readably nil)) ; lemacs uses this. |
14e7cb94 CY |
3576 | (condition-case nil |
3577 | (edebug-prin1-to-string value) | |
3578 | (error "#Apparently circular structure#")))) | |
1fe3d507 | 3579 | |
bd8d6108 | 3580 | (defun edebug-compute-previous-result (previous-value) |
e409c527 | 3581 | (if edebug-unwrap-results |
bd8d6108 SM |
3582 | (setq previous-value |
3583 | (edebug-unwrap* previous-value))) | |
1fe3d507 | 3584 | (setq edebug-previous-result |
e409c527 | 3585 | (concat "Result: " |
bd8d6108 SM |
3586 | (edebug-safe-prin1-to-string previous-value) |
3587 | (eval-expression-print-format previous-value)))) | |
84fc2cfa | 3588 | |
1fe3d507 DL |
3589 | (defun edebug-previous-result () |
3590 | "Print the previous result." | |
3591 | (interactive) | |
3592 | (message "%s" edebug-previous-result)) | |
84fc2cfa | 3593 | |
f7359658 | 3594 | ;;; Read, Eval and Print |
84fc2cfa | 3595 | |
03d5bbb0 RS |
3596 | (defalias 'edebug-prin1 'prin1) |
3597 | (defalias 'edebug-print 'print) | |
3598 | (defalias 'edebug-prin1-to-string 'prin1-to-string) | |
3599 | (defalias 'edebug-format 'format) | |
3600 | (defalias 'edebug-message 'message) | |
3601 | ||
bd8d6108 | 3602 | (defun edebug-eval-expression (expr) |
a1506d29 | 3603 | "Evaluate an expression in the outside environment. |
1fe3d507 | 3604 | If interactive, prompt for the expression. |
84fc2cfa | 3605 | Print result in minibuffer." |
a1506d29 | 3606 | (interactive (list (read-from-minibuffer |
10b088c6 RS |
3607 | "Eval: " nil read-expression-map t |
3608 | 'read-expression-history))) | |
1fe3d507 DL |
3609 | (princ |
3610 | (edebug-outside-excursion | |
bd8d6108 | 3611 | (setq values (cons (edebug-eval expr) values)) |
50a27de2 JL |
3612 | (concat (edebug-safe-prin1-to-string (car values)) |
3613 | (eval-expression-print-format (car values)))))) | |
84fc2cfa ER |
3614 | |
3615 | (defun edebug-eval-last-sexp () | |
b6386e63 LT |
3616 | "Evaluate sexp before point in the outside environment. |
3617 | Print value in minibuffer." | |
84fc2cfa | 3618 | (interactive) |
1fe3d507 | 3619 | (edebug-eval-expression (edebug-last-sexp))) |
84fc2cfa ER |
3620 | |
3621 | (defun edebug-eval-print-last-sexp () | |
b6386e63 | 3622 | "Evaluate sexp before point in outside environment; insert value. |
5fc58d83 | 3623 | This prints the value into current buffer." |
84fc2cfa | 3624 | (interactive) |
bd8d6108 SM |
3625 | (let* ((form (edebug-last-sexp)) |
3626 | (result-string | |
a1506d29 | 3627 | (edebug-outside-excursion |
bd8d6108 | 3628 | (edebug-safe-prin1-to-string (edebug-safe-eval form)))) |
1fe3d507 DL |
3629 | (standard-output (current-buffer))) |
3630 | (princ "\n") | |
3631 | ;; princ the string to get rid of quotes. | |
bd8d6108 | 3632 | (princ result-string) |
1fe3d507 DL |
3633 | (princ "\n") |
3634 | )) | |
3635 | ||
a1506d29 | 3636 | ;;; Edebug Minor Mode |
84fc2cfa | 3637 | |
f1a4e679 CY |
3638 | (defvar edebug-inhibit-emacs-lisp-mode-bindings nil |
3639 | "If non-nil, inhibit Edebug bindings on the C-x C-a key. | |
3640 | By default, loading the `edebug' library causes these bindings to | |
3641 | be installed in `emacs-lisp-mode-map'.") | |
3642 | ||
3643 | (define-obsolete-variable-alias 'gud-inhibit-global-bindings | |
2a1e2476 | 3644 | 'edebug-inhibit-emacs-lisp-mode-bindings "24.3") |
a1506d29 | 3645 | |
5fc58d83 | 3646 | ;; Global GUD bindings for all emacs-lisp-mode buffers. |
f1a4e679 | 3647 | (unless edebug-inhibit-emacs-lisp-mode-bindings |
5fc58d83 RS |
3648 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode) |
3649 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode) | |
3650 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode) | |
3651 | (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)) | |
84fc2cfa | 3652 | |
d778509c SM |
3653 | (defvar edebug-mode-map |
3654 | (let ((map (copy-keymap emacs-lisp-mode-map))) | |
84fc2cfa | 3655 | ;; control |
d778509c SM |
3656 | (define-key map " " 'edebug-step-mode) |
3657 | (define-key map "n" 'edebug-next-mode) | |
3658 | (define-key map "g" 'edebug-go-mode) | |
3659 | (define-key map "G" 'edebug-Go-nonstop-mode) | |
3660 | (define-key map "t" 'edebug-trace-mode) | |
3661 | (define-key map "T" 'edebug-Trace-fast-mode) | |
3662 | (define-key map "c" 'edebug-continue-mode) | |
3663 | (define-key map "C" 'edebug-Continue-fast-mode) | |
3664 | ||
3665 | ;;(define-key map "f" 'edebug-forward) not implemented | |
3666 | (define-key map "f" 'edebug-forward-sexp) | |
3667 | (define-key map "h" 'edebug-goto-here) | |
3668 | ||
3669 | (define-key map "I" 'edebug-instrument-callee) | |
3670 | (define-key map "i" 'edebug-step-in) | |
3671 | (define-key map "o" 'edebug-step-out) | |
a1506d29 | 3672 | |
1fe3d507 | 3673 | ;; quitting and stopping |
d778509c SM |
3674 | (define-key map "q" 'top-level) |
3675 | (define-key map "Q" 'edebug-top-level-nonstop) | |
3676 | (define-key map "a" 'abort-recursive-edit) | |
3677 | (define-key map "S" 'edebug-stop) | |
84fc2cfa ER |
3678 | |
3679 | ;; breakpoints | |
d778509c SM |
3680 | (define-key map "b" 'edebug-set-breakpoint) |
3681 | (define-key map "u" 'edebug-unset-breakpoint) | |
3682 | (define-key map "B" 'edebug-next-breakpoint) | |
3683 | (define-key map "x" 'edebug-set-conditional-breakpoint) | |
3684 | (define-key map "X" 'edebug-set-global-break-condition) | |
a1506d29 | 3685 | |
84fc2cfa | 3686 | ;; evaluation |
d778509c SM |
3687 | (define-key map "r" 'edebug-previous-result) |
3688 | (define-key map "e" 'edebug-eval-expression) | |
3689 | (define-key map "\C-x\C-e" 'edebug-eval-last-sexp) | |
3690 | (define-key map "E" 'edebug-visit-eval-list) | |
a1506d29 | 3691 | |
84fc2cfa | 3692 | ;; views |
d778509c SM |
3693 | (define-key map "w" 'edebug-where) |
3694 | (define-key map "v" 'edebug-view-outside) ;; maybe obsolete?? | |
3695 | (define-key map "p" 'edebug-bounce-point) | |
3696 | (define-key map "P" 'edebug-view-outside) ;; same as v | |
3697 | (define-key map "W" 'edebug-toggle-save-windows) | |
1fe3d507 | 3698 | |
84fc2cfa | 3699 | ;; misc |
d778509c SM |
3700 | (define-key map "?" 'edebug-help) |
3701 | (define-key map "d" 'edebug-backtrace) | |
a1506d29 | 3702 | |
d778509c | 3703 | (define-key map "-" 'negative-argument) |
1fe3d507 DL |
3704 | |
3705 | ;; statistics | |
d778509c | 3706 | (define-key map "=" 'edebug-temp-display-freq-count) |
1fe3d507 DL |
3707 | |
3708 | ;; GUD bindings | |
d778509c SM |
3709 | (define-key map "\C-c\C-s" 'edebug-step-mode) |
3710 | (define-key map "\C-c\C-n" 'edebug-next-mode) | |
3711 | (define-key map "\C-c\C-c" 'edebug-go-mode) | |
3712 | ||
3713 | (define-key map "\C-x " 'edebug-set-breakpoint) | |
3714 | (define-key map "\C-c\C-d" 'edebug-unset-breakpoint) | |
3715 | (define-key map "\C-c\C-t" | |
3716 | (lambda () (interactive) (edebug-set-breakpoint t))) | |
3717 | (define-key map "\C-c\C-l" 'edebug-where) | |
3718 | map)) | |
84fc2cfa | 3719 | |
1fe3d507 DL |
3720 | ;; Autoloading these global bindings doesn't make sense because |
3721 | ;; they cannot be used anyway unless Edebug is already loaded and active. | |
3722 | ||
84fc2cfa ER |
3723 | (defvar global-edebug-prefix "\^XX" |
3724 | "Prefix key for global edebug commands, available from any buffer.") | |
3725 | ||
d778509c SM |
3726 | (defvar global-edebug-map |
3727 | (let ((map (make-sparse-keymap))) | |
3728 | ||
3729 | (define-key map " " 'edebug-step-mode) | |
3730 | (define-key map "g" 'edebug-go-mode) | |
3731 | (define-key map "G" 'edebug-Go-nonstop-mode) | |
3732 | (define-key map "t" 'edebug-trace-mode) | |
3733 | (define-key map "T" 'edebug-Trace-fast-mode) | |
3734 | (define-key map "c" 'edebug-continue-mode) | |
3735 | (define-key map "C" 'edebug-Continue-fast-mode) | |
3736 | ||
3737 | ;; breakpoints | |
3738 | (define-key map "b" 'edebug-set-breakpoint) | |
3739 | (define-key map "u" 'edebug-unset-breakpoint) | |
3740 | (define-key map "x" 'edebug-set-conditional-breakpoint) | |
3741 | (define-key map "X" 'edebug-set-global-break-condition) | |
3742 | ||
3743 | ;; views | |
3744 | (define-key map "w" 'edebug-where) | |
3745 | (define-key map "W" 'edebug-toggle-save-windows) | |
3746 | ||
3747 | ;; quitting | |
3748 | (define-key map "q" 'top-level) | |
3749 | (define-key map "Q" 'edebug-top-level-nonstop) | |
3750 | (define-key map "a" 'abort-recursive-edit) | |
3751 | ||
3752 | ;; statistics | |
3753 | (define-key map "=" 'edebug-display-freq-count) | |
3754 | map) | |
84fc2cfa ER |
3755 | "Global map of edebug commands, available from any buffer.") |
3756 | ||
d778509c SM |
3757 | (global-unset-key global-edebug-prefix) |
3758 | (global-set-key global-edebug-prefix global-edebug-map) | |
3759 | ||
84fc2cfa ER |
3760 | |
3761 | (defun edebug-help () | |
1e46f9e4 | 3762 | "Describe `edebug-mode'." |
84fc2cfa ER |
3763 | (interactive) |
3764 | (describe-function 'edebug-mode)) | |
3765 | ||
17c781d1 SM |
3766 | (defvar edebug--mode-saved-vars nil) |
3767 | ||
3768 | (define-minor-mode edebug-mode | |
1fe3d507 DL |
3769 | "Mode for Emacs Lisp buffers while in Edebug. |
3770 | ||
3771 | In addition to all Emacs Lisp commands (except those that modify the | |
3772 | buffer) there are local and global key bindings to several Edebug | |
a1506d29 | 3773 | specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode] |
1fe3d507 | 3774 | in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer. |
84fc2cfa | 3775 | |
eb533587 | 3776 | Also see bindings for the eval list buffer *edebug* in `edebug-eval-mode'. |
84fc2cfa | 3777 | |
1fe3d507 | 3778 | The edebug buffer commands: |
84fc2cfa ER |
3779 | \\{edebug-mode-map} |
3780 | ||
1fe3d507 | 3781 | Global commands prefixed by `global-edebug-prefix': |
84fc2cfa ER |
3782 | \\{global-edebug-map} |
3783 | ||
3784 | Options: | |
9854542e SM |
3785 | `edebug-setup-hook' |
3786 | `edebug-all-defs' | |
3787 | `edebug-all-forms' | |
3788 | `edebug-save-windows' | |
3789 | `edebug-save-displayed-buffer-points' | |
3790 | `edebug-initial-mode' | |
3791 | `edebug-trace' | |
3792 | `edebug-test-coverage' | |
3793 | `edebug-continue-kbd-macro' | |
3794 | `edebug-print-length' | |
3795 | `edebug-print-level' | |
3796 | `edebug-print-circle' | |
3797 | `edebug-on-error' | |
3798 | `edebug-on-quit' | |
3799 | `edebug-on-signal' | |
3800 | `edebug-unwrap-results' | |
3801 | `edebug-global-break-condition'" | |
17c781d1 SM |
3802 | :lighter " *Debugging*" |
3803 | :keymap edebug-mode-map | |
e20e4a48 RS |
3804 | ;; If the user kills the buffer in which edebug is currently active, |
3805 | ;; exit to top level, because the edebug command loop can't usefully | |
3806 | ;; continue running in such a case. | |
7b0e2f85 | 3807 | ;; |
17c781d1 SM |
3808 | (if (not edebug-mode) |
3809 | (progn | |
3810 | (while edebug--mode-saved-vars | |
3811 | (let ((setting (pop edebug--mode-saved-vars))) | |
3812 | (if (consp setting) | |
3813 | (set (car setting) (cdr setting)) | |
3814 | (kill-local-variable setting)))) | |
3815 | (remove-hook 'kill-buffer-hook 'edebug-kill-buffer t)) | |
3816 | (pcase-dolist (`(,var . ,val) '((buffer-read-only . t))) | |
3817 | (push | |
6fcdab68 | 3818 | (if (local-variable-p var) (cons var (symbol-value var)) var) |
17c781d1 SM |
3819 | edebug--mode-saved-vars) |
3820 | (set (make-local-variable var) val)) | |
3821 | ;; Append `edebug-kill-buffer' to the hook to avoid interfering with | |
b9edfa5c | 3822 | ;; other entries that are unguarded against deleted buffer. |
17c781d1 | 3823 | (add-hook 'kill-buffer-hook 'edebug-kill-buffer t t))) |
84fc2cfa | 3824 | |
e20e4a48 RS |
3825 | (defun edebug-kill-buffer () |
3826 | "Used on `kill-buffer-hook' when Edebug is operating in a buffer of Lisp code." | |
17c781d1 | 3827 | (run-with-timer 0 nil #'top-level)) |
e20e4a48 | 3828 | |
f7359658 | 3829 | ;;; edebug eval list mode |
84fc2cfa | 3830 | |
1fe3d507 | 3831 | ;; A list of expressions and their evaluations is displayed in *edebug*. |
84fc2cfa ER |
3832 | |
3833 | (defun edebug-eval-result-list () | |
242b1f68 | 3834 | "Return a list of evaluations of `edebug-eval-list'." |
84fc2cfa | 3835 | ;; Assumes in outside environment. |
88668147 DL |
3836 | ;; Don't do any edebug things now. |
3837 | (let ((edebug-execution-mode 'Go-nonstop) | |
a1506d29 | 3838 | (edebug-trace nil)) |
88668147 | 3839 | (mapcar 'edebug-safe-eval edebug-eval-list))) |
84fc2cfa | 3840 | |
bd8d6108 | 3841 | (defun edebug-eval-display-list (eval-result-list) |
84fc2cfa | 3842 | ;; Assumes edebug-eval-buffer exists. |
bd8d6108 | 3843 | (let ((standard-output edebug-eval-buffer) |
1fe3d507 | 3844 | (edebug-comment-line |
84fc2cfa | 3845 | (format ";%s\n" (make-string (- (window-width) 2) ?-)))) |
1fe3d507 | 3846 | (set-buffer edebug-eval-buffer) |
84fc2cfa | 3847 | (erase-buffer) |
bd8d6108 SM |
3848 | (dolist (exp edebug-eval-list) |
3849 | (prin1 exp) (terpri) | |
3850 | (prin1 (pop eval-result-list)) (terpri) | |
3851 | (princ edebug-comment-line)) | |
1fe3d507 | 3852 | (edebug-pop-to-buffer edebug-eval-buffer) |
84fc2cfa ER |
3853 | )) |
3854 | ||
3855 | (defun edebug-create-eval-buffer () | |
c0c54fbd SM |
3856 | (unless (and edebug-eval-buffer (buffer-name edebug-eval-buffer)) |
3857 | (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*"))) | |
3858 | (edebug-eval-mode))) | |
84fc2cfa ER |
3859 | |
3860 | ;; Should generalize this to be callable outside of edebug | |
3861 | ;; with calls in user functions, e.g. (edebug-eval-display) | |
3862 | ||
bd8d6108 SM |
3863 | (defun edebug-eval-display (eval-result-list) |
3864 | "Display expressions and evaluations in EVAL-RESULT-LIST. | |
84fc2cfa | 3865 | It modifies the context by popping up the eval display." |
bd8d6108 SM |
3866 | (when eval-result-list |
3867 | (edebug-create-eval-buffer) | |
3868 | (edebug-eval-display-list eval-result-list))) | |
84fc2cfa ER |
3869 | |
3870 | (defun edebug-eval-redisplay () | |
3871 | "Redisplay eval list in outside environment. | |
bd8d6108 | 3872 | May only be called from within `edebug--recursive-edit'." |
84fc2cfa | 3873 | (edebug-create-eval-buffer) |
84fc2cfa ER |
3874 | (edebug-outside-excursion |
3875 | (edebug-eval-display-list (edebug-eval-result-list)) | |
3876 | )) | |
3877 | ||
3878 | (defun edebug-visit-eval-list () | |
1e46f9e4 | 3879 | "Switch to the evaluation list buffer \"*edebug*\"." |
84fc2cfa ER |
3880 | (interactive) |
3881 | (edebug-eval-redisplay) | |
3882 | (edebug-pop-to-buffer edebug-eval-buffer)) | |
3883 | ||
3884 | ||
3885 | (defun edebug-update-eval-list () | |
3886 | "Replace the evaluation list with the sexps now in the eval buffer." | |
3887 | (interactive) | |
3888 | (let ((starting-point (point)) | |
3889 | new-list) | |
3890 | (goto-char (point-min)) | |
3891 | ;; get the first expression | |
3892 | (edebug-skip-whitespace) | |
3893 | (if (not (eobp)) | |
3894 | (progn | |
3895 | (forward-sexp 1) | |
c0c54fbd | 3896 | (push (edebug-last-sexp) new-list))) |
a1506d29 | 3897 | |
84fc2cfa ER |
3898 | (while (re-search-forward "^;" nil t) |
3899 | (forward-line 1) | |
3900 | (skip-chars-forward " \t\n\r") | |
3901 | (if (and (/= ?\; (following-char)) | |
3902 | (not (eobp))) | |
3903 | (progn | |
3904 | (forward-sexp 1) | |
c0c54fbd | 3905 | (push (edebug-last-sexp) new-list)))) |
a1506d29 | 3906 | |
84fc2cfa ER |
3907 | (setq edebug-eval-list (nreverse new-list)) |
3908 | (edebug-eval-redisplay) | |
3909 | (goto-char starting-point))) | |
3910 | ||
3911 | ||
3912 | (defun edebug-delete-eval-item () | |
3913 | "Delete the item under point and redisplay." | |
3914 | ;; could add arg to do repeatedly | |
3915 | (interactive) | |
3916 | (if (re-search-backward "^;" nil 'nofail) | |
3917 | (forward-line 1)) | |
3918 | (delete-region | |
3919 | (point) (progn (re-search-forward "^;" nil 'nofail) | |
3920 | (beginning-of-line) | |
3921 | (point))) | |
3922 | (edebug-update-eval-list)) | |
3923 | ||
3924 | ||
3925 | ||
a0310a6c DN |
3926 | (defvar edebug-eval-mode-map |
3927 | (let ((map (make-sparse-keymap))) | |
3928 | (set-keymap-parent map lisp-interaction-mode-map) | |
3929 | (define-key map "\C-c\C-w" 'edebug-where) | |
3930 | (define-key map "\C-c\C-d" 'edebug-delete-eval-item) | |
3931 | (define-key map "\C-c\C-u" 'edebug-update-eval-list) | |
3932 | (define-key map "\C-x\C-e" 'edebug-eval-last-sexp) | |
3933 | (define-key map "\C-j" 'edebug-eval-print-last-sexp) | |
bd8d6108 SM |
3934 | map) |
3935 | "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.") | |
84fc2cfa | 3936 | |
b7414395 | 3937 | (put 'edebug-eval-mode 'mode-class 'special) |
84fc2cfa | 3938 | |
e5d79aa5 | 3939 | (define-derived-mode edebug-eval-mode lisp-interaction-mode "Edebug Eval" |
1fe3d507 DL |
3940 | "Mode for evaluation list buffer while in Edebug. |
3941 | ||
3942 | In addition to all Interactive Emacs Lisp commands there are local and | |
3943 | global key bindings to several Edebug specific commands. E.g. | |
3944 | `edebug-step-mode' is bound to \\[edebug-step-mode] in the Edebug | |
3945 | buffer and \\<global-map>\\[edebug-step-mode] in any buffer. | |
84fc2cfa ER |
3946 | |
3947 | Eval list buffer commands: | |
3948 | \\{edebug-eval-mode-map} | |
3949 | ||
eb533587 | 3950 | Global commands prefixed by `global-edebug-prefix': |
e5d79aa5 | 3951 | \\{global-edebug-map}") |
84fc2cfa | 3952 | |
f7359658 | 3953 | ;;; Interface with standard debugger. |
84fc2cfa | 3954 | |
1fe3d507 DL |
3955 | ;; (setq debugger 'edebug) ; to use the edebug debugger |
3956 | ;; (setq debugger 'debug) ; use the standard debugger | |
84fc2cfa | 3957 | |
1fe3d507 DL |
3958 | ;; Note that debug and its utilities must be byte-compiled to work, |
3959 | ;; since they depend on the backtrace looking a certain way. But | |
3960 | ;; edebug is not dependent on this, yet. | |
84fc2cfa | 3961 | |
bd8d6108 | 3962 | (defun edebug (&optional arg-mode &rest args) |
242b1f68 JB |
3963 | "Replacement for `debug'. |
3964 | If we are running an edebugged function, show where we last were. | |
3965 | Otherwise call `debug' normally." | |
bd8d6108 SM |
3966 | ;;(message "entered: %s depth: %s edebug-recursion-depth: %s" |
3967 | ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1) | |
1fe3d507 DL |
3968 | (if (and edebug-entered ; anything active? |
3969 | (eq (recursion-depth) edebug-recursion-depth)) | |
3970 | (let (;; Where were we before the error occurred? | |
bd8d6108 SM |
3971 | (offset-index (car edebug-offset-indices)) |
3972 | (value (car args)) | |
3973 | ;; Bind variables required by edebug--display. | |
1fe3d507 DL |
3974 | edebug-breakpoints |
3975 | edebug-break-data | |
3976 | edebug-break-condition | |
3977 | edebug-global-break | |
bd8d6108 | 3978 | (edebug-break (null arg-mode)) ;; If called explicitly. |
1fe3d507 | 3979 | ) |
bd8d6108 SM |
3980 | (edebug--display value offset-index arg-mode) |
3981 | (if (eq arg-mode 'error) | |
1fe3d507 | 3982 | nil |
bd8d6108 | 3983 | value)) |
84fc2cfa ER |
3984 | |
3985 | ;; Otherwise call debug normally. | |
3986 | ;; Still need to remove extraneous edebug calls from stack. | |
bd8d6108 | 3987 | (apply 'debug arg-mode args) |
84fc2cfa ER |
3988 | )) |
3989 | ||
3990 | ||
3991 | (defun edebug-backtrace () | |
3992 | "Display a non-working backtrace. Better than nothing..." | |
3993 | (interactive) | |
1fe3d507 DL |
3994 | (if (or (not edebug-backtrace-buffer) |
3995 | (null (buffer-name edebug-backtrace-buffer))) | |
3996 | (setq edebug-backtrace-buffer | |
3997 | (generate-new-buffer "*Backtrace*")) | |
bd8d6108 | 3998 | ;; Else, could just display edebug-backtrace-buffer. |
1fe3d507 DL |
3999 | ) |
4000 | (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) | |
4001 | (setq edebug-backtrace-buffer standard-output) | |
4002 | (let ((print-escape-newlines t) | |
1e46f9e4 | 4003 | (print-length 50) ; FIXME cf edebug-safe-prin1-to-string |
1fe3d507 | 4004 | last-ok-point) |
84fc2cfa ER |
4005 | (backtrace) |
4006 | ||
a1506d29 | 4007 | ;; Clean up the backtrace. |
1fe3d507 DL |
4008 | ;; Not quite right for current edebug scheme. |
4009 | (set-buffer edebug-backtrace-buffer) | |
4010 | (setq truncate-lines t) | |
84fc2cfa | 4011 | (goto-char (point-min)) |
84fc2cfa | 4012 | (setq last-ok-point (point)) |
1fe3d507 | 4013 | (if t (progn |
84fc2cfa ER |
4014 | |
4015 | ;; Delete interspersed edebug internals. | |
1fe3d507 DL |
4016 | (while (re-search-forward "^ \(?edebug" nil t) |
4017 | (beginning-of-line) | |
a1506d29 | 4018 | (cond |
1fe3d507 | 4019 | ((looking-at "^ \(edebug-after") |
bd8d6108 | 4020 | ;; Previous lines may contain code, so just delete this line. |
1fe3d507 DL |
4021 | (setq last-ok-point (point)) |
4022 | (forward-line 1) | |
4023 | (delete-region last-ok-point (point))) | |
4024 | ||
4025 | ((looking-at "^ edebug") | |
4026 | (forward-line 1) | |
4027 | (delete-region last-ok-point (point)) | |
4028 | ))) | |
4029 | ))))) | |
84fc2cfa ER |
4030 | |
4031 | \f | |
f7359658 | 4032 | ;;; Trace display |
84fc2cfa ER |
4033 | |
4034 | (defun edebug-trace-display (buf-name fmt &rest args) | |
4035 | "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible. | |
4036 | The buffer is created if it does not exist. | |
1fe3d507 | 4037 | You must include newlines in FMT to break lines, but one newline is appended." |
2de39f08 SM |
4038 | ;; e.g. |
4039 | ;; (edebug-trace-display "*trace-point*" | |
4040 | ;; "saving: point = %s window-start = %s" | |
4041 | ;; (point) (window-start)) | |
dc0e03f3 RS |
4042 | (let* ((oldbuf (current-buffer)) |
4043 | (selected-window (selected-window)) | |
84fc2cfa | 4044 | (buffer (get-buffer-create buf-name)) |
1fe3d507 | 4045 | buf-window) |
2de39f08 | 4046 | ;; (message "before pop-to-buffer") (sit-for 1) |
84fc2cfa | 4047 | (edebug-pop-to-buffer buffer) |
1fe3d507 DL |
4048 | (setq truncate-lines t) |
4049 | (setq buf-window (selected-window)) | |
4050 | (goto-char (point-max)) | |
4051 | (insert (apply 'edebug-format fmt args) "\n") | |
4052 | ;; Make it visible. | |
4053 | (vertical-motion (- 1 (window-height))) | |
4054 | (set-window-start buf-window (point)) | |
4055 | (goto-char (point-max)) | |
2de39f08 SM |
4056 | ;; (set-window-point buf-window (point)) |
4057 | ;; (sit-for 0) | |
1fe3d507 | 4058 | (bury-buffer buffer) |
dc0e03f3 RS |
4059 | (select-window selected-window) |
4060 | (set-buffer oldbuf)) | |
1fe3d507 DL |
4061 | buf-name) |
4062 | ||
4063 | ||
4064 | (defun edebug-trace (fmt &rest args) | |
242b1f68 | 4065 | "Convenience call to `edebug-trace-display' using `edebug-trace-buffer'." |
1fe3d507 DL |
4066 | (apply 'edebug-trace-display edebug-trace-buffer fmt args)) |
4067 | ||
4068 | \f | |
f7359658 | 4069 | ;;; Frequency count and coverage |
1fe3d507 | 4070 | |
1e46f9e4 | 4071 | ;; FIXME should this use overlays instead? |
0b021094 GM |
4072 | ;; Definitely, IMO. The current business with undo in |
4073 | ;; edebug-temp-display-freq-count is horrid. | |
1fe3d507 | 4074 | (defun edebug-display-freq-count () |
1ae7cf5e | 4075 | "Display the frequency count data for each line of the current definition. |
242b1f68 JB |
4076 | The frequency counts are inserted as comment lines after each line, |
4077 | and you can undo all insertions with one `undo' command. | |
1fe3d507 DL |
4078 | |
4079 | The counts are inserted starting under the `(' before an expression | |
4080 | or the `)' after an expression, or on the last char of a symbol. | |
4081 | The counts are only displayed when they differ from previous counts on | |
4082 | the same line. | |
4083 | ||
4084 | If coverage is being tested, whenever all known results of an expression | |
4085 | are `eq', the char `=' will be appended after the count | |
4086 | for that expression. Note that this is always the case for an | |
4087 | expression only evaluated once. | |
4088 | ||
4089 | To clear the frequency count and coverage data for a definition, | |
4090 | reinstrument it." | |
4091 | (interactive) | |
4092 | (let* ((function (edebug-form-data-symbol)) | |
4093 | (counts (get function 'edebug-freq-count)) | |
4094 | (coverages (get function 'edebug-coverage)) | |
4095 | (data (get function 'edebug)) | |
4096 | (def-mark (car data)) ; mark at def start | |
4097 | (edebug-points (nth 2 data)) | |
4098 | (i (1- (length edebug-points))) | |
4099 | (last-index) | |
4100 | (first-index) | |
4101 | (start-of-line) | |
4102 | (start-of-count-line) | |
4103 | (last-count) | |
4104 | ) | |
84fc2cfa | 4105 | (save-excursion |
1fe3d507 DL |
4106 | ;; Traverse in reverse order so offsets are correct. |
4107 | (while (<= 0 i) | |
4108 | ;; Start at last expression in line. | |
4109 | (goto-char (+ def-mark (aref edebug-points i))) | |
4110 | (beginning-of-line) | |
4111 | (setq start-of-line (- (point) def-mark) | |
4112 | last-index i) | |
4113 | ||
4114 | ;; Find all indexes on same line. | |
a1506d29 | 4115 | (while (and (<= 0 (setq i (1- i))) |
1fe3d507 DL |
4116 | (<= start-of-line (aref edebug-points i)))) |
4117 | ;; Insert all the indices for this line. | |
4118 | (forward-line 1) | |
4119 | (setq start-of-count-line (point) | |
2de39f08 SM |
4120 | first-index i ; Really, last index for line above this one. |
4121 | last-count -1) ; Cause first count to always appear. | |
1fe3d507 DL |
4122 | (insert ";#") |
4123 | ;; i == first-index still | |
4124 | (while (<= (setq i (1+ i)) last-index) | |
4125 | (let ((count (aref counts i)) | |
4126 | (coverage (aref coverages i)) | |
4127 | (col (save-excursion | |
4128 | (goto-char (+ (aref edebug-points i) def-mark)) | |
4129 | (- (current-column) | |
4130 | (if (= ?\( (following-char)) 0 1))))) | |
a1506d29 | 4131 | (insert (make-string |
ea400c88 | 4132 | (max 0 (- col (- (point) start-of-count-line))) ?\s) |
1fe3d507 | 4133 | (if (and (< 0 count) |
a1506d29 | 4134 | (not (memq coverage |
1fe3d507 DL |
4135 | '(unknown ok-coverage)))) |
4136 | "=" "") | |
4137 | (if (= count last-count) "" (int-to-string count)) | |
4138 | " ") | |
4139 | (setq last-count count))) | |
4140 | (insert "\n") | |
4141 | (setq i first-index))))) | |
4142 | ||
0b021094 GM |
4143 | ;; FIXME this does not work very well. Eg if you press an arrow key, |
4144 | ;; or make a mouse-click, it fails with "Non-character input-event". | |
1fe3d507 DL |
4145 | (defun edebug-temp-display-freq-count () |
4146 | "Temporarily display the frequency count data for the current definition. | |
4147 | It is removed when you hit any char." | |
4148 | ;; This seems not to work with Emacs 18.59. It undoes too far. | |
4149 | (interactive) | |
17c781d1 | 4150 | (let ((inhibit-read-only t)) |
1fe3d507 DL |
4151 | (undo-boundary) |
4152 | (edebug-display-freq-count) | |
2de39f08 SM |
4153 | (setq unread-command-events |
4154 | (append unread-command-events (list (read-event)))) | |
0b021094 | 4155 | ;; Yuck! This doesn't seem to work at all for me. |
1fe3d507 DL |
4156 | (undo))) |
4157 | ||
4158 | \f | |
f7359658 | 4159 | ;;; Menus |
1fe3d507 DL |
4160 | |
4161 | (defun edebug-toggle (variable) | |
a0ee6f27 SM |
4162 | (set variable (not (symbol-value variable))) |
4163 | (message "%s: %s" variable (symbol-value variable))) | |
1fe3d507 DL |
4164 | |
4165 | ;; We have to require easymenu (even for Emacs 18) just so | |
4166 | ;; the easy-menu-define macro call is compiled correctly. | |
4167 | (require 'easymenu) | |
4168 | ||
4169 | (defconst edebug-mode-menus | |
4170 | '("Edebug" | |
1fe3d507 DL |
4171 | ["Stop" edebug-stop t] |
4172 | ["Step" edebug-step-mode t] | |
4173 | ["Next" edebug-next-mode t] | |
4174 | ["Trace" edebug-trace-mode t] | |
4175 | ["Trace Fast" edebug-Trace-fast-mode t] | |
4176 | ["Continue" edebug-continue-mode t] | |
4177 | ["Continue Fast" edebug-Continue-fast-mode t] | |
4178 | ["Go" edebug-go-mode t] | |
4179 | ["Go Nonstop" edebug-Go-nonstop-mode t] | |
4180 | "----" | |
4181 | ["Help" edebug-help t] | |
4182 | ["Abort" abort-recursive-edit t] | |
4183 | ["Quit to Top Level" top-level t] | |
4184 | ["Quit Nonstop" edebug-top-level-nonstop t] | |
4185 | "----" | |
4186 | ("Jumps" | |
4187 | ["Forward Sexp" edebug-forward-sexp t] | |
4188 | ["Step In" edebug-step-in t] | |
4189 | ["Step Out" edebug-step-out t] | |
4190 | ["Goto Here" edebug-goto-here t]) | |
4191 | ||
4192 | ("Breaks" | |
4193 | ["Set Breakpoint" edebug-set-breakpoint t] | |
4194 | ["Unset Breakpoint" edebug-unset-breakpoint t] | |
4195 | ["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t] | |
4196 | ["Set Global Break Condition" edebug-set-global-break-condition t] | |
4197 | ["Show Next Breakpoint" edebug-next-breakpoint t]) | |
4198 | ||
4199 | ("Views" | |
4200 | ["Where am I?" edebug-where t] | |
4201 | ["Bounce to Current Point" edebug-bounce-point t] | |
4202 | ["View Outside Windows" edebug-view-outside t] | |
4203 | ["Previous Result" edebug-previous-result t] | |
4204 | ["Show Backtrace" edebug-backtrace t] | |
4205 | ["Display Freq Count" edebug-display-freq-count t]) | |
4206 | ||
4207 | ("Eval" | |
4208 | ["Expression" edebug-eval-expression t] | |
4209 | ["Last Sexp" edebug-eval-last-sexp t] | |
4210 | ["Visit Eval List" edebug-visit-eval-list t]) | |
4211 | ||
4212 | ("Options" | |
6db746da DL |
4213 | ["Edebug All Defs" edebug-all-defs |
4214 | :style toggle :selected edebug-all-defs] | |
4215 | ["Edebug All Forms" edebug-all-forms | |
4216 | :style toggle :selected edebug-all-forms] | |
1fe3d507 | 4217 | "----" |
6db746da DL |
4218 | ["Tracing" (edebug-toggle 'edebug-trace) |
4219 | :style toggle :selected edebug-trace] | |
4220 | ["Test Coverage" (edebug-toggle 'edebug-test-coverage) | |
4221 | :style toggle :selected edebug-test-coverage] | |
4222 | ["Save Windows" edebug-toggle-save-windows | |
4223 | :style toggle :selected edebug-save-windows] | |
a1506d29 | 4224 | ["Save Point" |
6db746da DL |
4225 | (edebug-toggle 'edebug-save-displayed-buffer-points) |
4226 | :style toggle :selected edebug-save-displayed-buffer-points] | |
1fe3d507 | 4227 | )) |
6db746da | 4228 | "Menus for Edebug.") |
1fe3d507 DL |
4229 | |
4230 | \f | |
f7359658 RS |
4231 | ;;; Emacs version specific code |
4232 | ||
10b088c6 | 4233 | (defalias 'edebug-window-live-p 'window-live-p) |
1fe3d507 | 4234 | |
10b088c6 | 4235 | (defun edebug-mark () |
f5c9c551 | 4236 | (mark t)) |
10b088c6 RS |
4237 | |
4238 | (defun edebug-set-conditional-breakpoint (arg condition) | |
4239 | "Set a conditional breakpoint at nearest sexp. | |
4240 | The condition is evaluated in the outside context. | |
4241 | With prefix argument, make it a temporary breakpoint." | |
4242 | ;; (interactive "P\nxCondition: ") | |
a1506d29 | 4243 | (interactive |
10b088c6 RS |
4244 | (list |
4245 | current-prefix-arg | |
20c78df0 | 4246 | ;; Read condition as follows; getting previous condition is cumbersome: |
10b088c6 RS |
4247 | (let ((edebug-stop-point (edebug-find-stop-point))) |
4248 | (if edebug-stop-point | |
4249 | (let* ((edebug-def-name (car edebug-stop-point)) | |
4250 | (index (cdr edebug-stop-point)) | |
4251 | (edebug-data (get edebug-def-name 'edebug)) | |
4252 | (edebug-breakpoints (car (cdr edebug-data))) | |
4253 | (edebug-break-data (assq index edebug-breakpoints)) | |
4254 | (edebug-break-condition (car (cdr edebug-break-data))) | |
20c78df0 JL |
4255 | (initial (and edebug-break-condition |
4256 | (format "%s" edebug-break-condition)))) | |
4257 | (read-from-minibuffer | |
4258 | "Condition: " initial read-expression-map t | |
4259 | (if (equal (car read-expression-history) initial) | |
4260 | '(read-expression-history . 1) | |
4261 | 'read-expression-history))))))) | |
10b088c6 RS |
4262 | (edebug-modify-breakpoint t condition arg)) |
4263 | ||
0b936a1e | 4264 | (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus) |
1fe3d507 | 4265 | \f |
f7359658 | 4266 | ;;; Autoloading of Edebug accessories |
1fe3d507 | 4267 | |
b1a03ef6 | 4268 | ;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu |
5f3a3bb1 JB |
4269 | (defun edebug--require-cl-read () |
4270 | (require 'edebug-cl-read)) | |
4271 | ||
1fe3d507 | 4272 | (if (featurep 'cl-read) |
5f3a3bb1 | 4273 | (add-hook 'edebug-setup-hook #'edebug--require-cl-read) |
1fe3d507 | 4274 | ;; The following causes edebug-cl-read to be loaded when you load cl-read.el. |
5f3a3bb1 | 4275 | (add-hook 'cl-read-load-hooks #'edebug--require-cl-read)) |
1fe3d507 DL |
4276 | |
4277 | \f | |
f7359658 | 4278 | ;;; Finalize Loading |
1fe3d507 | 4279 | |
23ba2705 SM |
4280 | ;; When edebugging a function, some of the sub-expressions are |
4281 | ;; wrapped in (edebug-enter (lambda () ..)), so we need to teach | |
4282 | ;; called-interactively-p that calls within the inner lambda should refer to | |
4283 | ;; the outside function. | |
4284 | (add-hook 'called-interactively-p-functions | |
4285 | #'edebug--called-interactively-skip) | |
4286 | (defun edebug--called-interactively-skip (i frame1 frame2) | |
4287 | (when (and (eq (car-safe (nth 1 frame1)) 'lambda) | |
4288 | (eq (nth 1 (nth 1 frame1)) '()) | |
4289 | (eq (nth 1 frame2) 'edebug-enter)) | |
4290 | ;; `edebug-enter' calls itself on its first invocation. | |
4291 | (if (eq (nth 1 (internal--called-interactively-p--get-frame i)) | |
4292 | 'edebug-enter) | |
4293 | 2 1))) | |
4294 | ||
b1a03ef6 SM |
4295 | ;; Finally, hook edebug into the rest of Emacs. |
4296 | ;; There are probably some other things that could go here. | |
1fe3d507 DL |
4297 | |
4298 | ;; Install edebug read and eval functions. | |
4299 | (edebug-install-read-eval-functions) | |
84fc2cfa | 4300 | |
5f3a3bb1 JB |
4301 | (defun edebug-unload-function () |
4302 | "Unload the Edebug source level debugger." | |
4303 | (when edebug-active | |
ce0440ff | 4304 | (setq edebug-active nil) |
5f3a3bb1 JB |
4305 | (unwind-protect |
4306 | (abort-recursive-edit) | |
ce0440ff JB |
4307 | ;; We still want to run unload-feature to completion |
4308 | (run-with-idle-timer 0 nil #'(lambda () (unload-feature 'edebug))))) | |
5f3a3bb1 JB |
4309 | (remove-hook 'called-interactively-p-functions |
4310 | 'edebug--called-interactively-skip) | |
4311 | (remove-hook 'cl-read-load-hooks 'edebug--require-cl-read) | |
4312 | (edebug-uninstall-read-eval-functions) | |
4313 | ;; continue standard unloading | |
4314 | nil) | |
4315 | ||
e8544af2 RS |
4316 | (provide 'edebug) |
4317 | ||
84fc2cfa | 4318 | ;;; edebug.el ends here |