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