![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to debug.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to debug.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 ! root 1: ;; Debuggers and related commands for Emacs ! 2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 7: ;; it under the terms of the GNU General Public License as published by ! 8: ;; the Free Software Foundation; either version 1, or (at your option) ! 9: ;; any later version. ! 10: ! 11: ;; GNU Emacs is distributed in the hope that it will be useful, ! 12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: ;; GNU General Public License for more details. ! 15: ! 16: ;; You should have received a copy of the GNU General Public License ! 17: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 19: ! 20: ! 21: (setq debugger 'debug) ! 22: ! 23: (defun debug (&rest debugger-args) ! 24: "Enter debugger. Returns if user says \"continue\". ! 25: Arguments are mainly for use when this is called ! 26: from the internals of the evaluator. ! 27: You may call with no args, or you may ! 28: pass nil as the first arg and any other args you like. ! 29: In that case, the list of args after the first will ! 30: be printed into the backtrace buffer." ! 31: (message "Entering debugger...") ! 32: (let (debugger-value ! 33: (debugger-match-data (match-data)) ! 34: (debug-on-error nil) ! 35: (debug-on-quit nil) ! 36: (debugger-buffer (let ((default-major-mode 'fundamental-mode)) ! 37: (generate-new-buffer "*Backtrace*"))) ! 38: (debugger-old-buffer (current-buffer)) ! 39: (debugger-step-after-exit nil) ! 40: ;; Don't keep reading from an executing kbd macro! ! 41: (executing-macro nil) ! 42: (cursor-in-echo-area nil)) ! 43: (unwind-protect ! 44: (save-excursion ! 45: (save-window-excursion ! 46: (pop-to-buffer debugger-buffer) ! 47: (erase-buffer) ! 48: (let ((standard-output (current-buffer)) ! 49: (print-escape-newlines t) ! 50: (print-length 50)) ! 51: (backtrace)) ! 52: (goto-char (point-min)) ! 53: (debugger-mode) ! 54: (delete-region (point) ! 55: (progn ! 56: (forward-sexp 8) ! 57: (forward-line 1) ! 58: (point))) ! 59: (cond ((memq (car debugger-args) '(lambda debug)) ! 60: (insert "Entering:\n") ! 61: (if (eq (car debugger-args) 'debug) ! 62: (progn ! 63: (backtrace-debug 4 t) ! 64: (delete-char 1) ! 65: (insert ?*) ! 66: (beginning-of-line)))) ! 67: ((eq (car debugger-args) 'exit) ! 68: (insert "Return value: ") ! 69: (setq debugger-value (nth 1 debugger-args)) ! 70: (prin1 debugger-value (current-buffer)) ! 71: (insert ?\n) ! 72: (delete-char 1) ! 73: (insert ? ) ! 74: (beginning-of-line)) ! 75: ((eq (car debugger-args) 'error) ! 76: (insert "Signalling: ") ! 77: (prin1 (nth 1 debugger-args) (current-buffer)) ! 78: (insert ?\n)) ! 79: ((eq (car debugger-args) t) ! 80: (insert "Beginning evaluation of function call form:\n")) ! 81: (t ! 82: (prin1 (if (eq (car debugger-args) 'nil) ! 83: (cdr debugger-args) debugger-args) ! 84: (current-buffer)) ! 85: (insert ?\n))) ! 86: (message "") ! 87: (let ((inhibit-trace t) ! 88: (standard-output nil) ! 89: (buffer-read-only t)) ! 90: (message "") ! 91: (recursive-edit)))) ! 92: ;; So that users do not try to execute debugger commands ! 93: ;; in an invalid context ! 94: (kill-buffer debugger-buffer) ! 95: (store-match-data debugger-match-data)) ! 96: (setq debug-on-next-call debugger-step-after-exit) ! 97: debugger-value)) ! 98: ! 99: (defun debugger-step-through () ! 100: "Proceed, stepping through subexpressions of this expression. ! 101: Enter another debugger on next entry to eval, apply or funcall." ! 102: (interactive) ! 103: (setq debugger-step-after-exit t) ! 104: (message "Proceding, will debug on next eval or call.") ! 105: (exit-recursive-edit)) ! 106: ! 107: (defun debugger-continue () ! 108: "Continue, evaluating this expression without stopping." ! 109: (interactive) ! 110: (message "Continuing.") ! 111: (exit-recursive-edit)) ! 112: ! 113: (defun debugger-return-value (val) ! 114: "Continue, specifying value to return. ! 115: This is only useful when the value returned from the debugger ! 116: will be used, such as in a debug on exit from a frame." ! 117: (interactive "XReturn value (evaluated): ") ! 118: (setq debugger-value val) ! 119: (princ "Returning " t) ! 120: (prin1 debugger-value) ! 121: (exit-recursive-edit)) ! 122: ! 123: (defun debugger-frame-number () ! 124: "Return number of frames in backtrace before the one point points at." ! 125: (save-excursion ! 126: (beginning-of-line) ! 127: (let ((opoint (point)) ! 128: (count 0)) ! 129: (goto-char (point-min)) ! 130: (if (or (equal (buffer-substring (point) (+ (point) 6)) ! 131: "Signal") ! 132: (equal (buffer-substring (point) (+ (point) 6)) ! 133: "Return")) ! 134: (progn ! 135: (search-forward ":") ! 136: (forward-sexp 1))) ! 137: (forward-line 1) ! 138: (while (progn ! 139: (forward-char 2) ! 140: (if (= (following-char) ?\() ! 141: (forward-sexp 1) ! 142: (forward-sexp 2)) ! 143: (forward-line 1) ! 144: (<= (point) opoint)) ! 145: (setq count (1+ count))) ! 146: count))) ! 147: ! 148: ;; Chosen empirically to account for all the frames ! 149: ;; that will exist when debugger-frame is called ! 150: ;; within the first one that appears in the backtrace buffer. ! 151: ;; Assumes debugger-frame is called from a key; ! 152: ;; will be wrong if it is called with Meta-x. ! 153: (defconst debugger-frame-offset 8 "") ! 154: ! 155: (defun debugger-frame () ! 156: "Request entry to debugger when this frame exits. ! 157: Applies to the frame whose line point is on in the backtrace." ! 158: (interactive) ! 159: (beginning-of-line) ! 160: (let ((level (debugger-frame-number))) ! 161: (backtrace-debug (+ level debugger-frame-offset) t)) ! 162: (if (= (following-char) ? ) ! 163: (let ((buffer-read-only nil)) ! 164: (delete-char 1) ! 165: (insert ?*))) ! 166: (beginning-of-line)) ! 167: ! 168: (defun debugger-frame-clear () ! 169: "Do not enter to debugger when this frame exits. ! 170: Applies to the frame whose line point is on in the backtrace." ! 171: (interactive) ! 172: (beginning-of-line) ! 173: (let ((level (debugger-frame-number))) ! 174: (backtrace-debug (+ level debugger-frame-offset) nil)) ! 175: (if (= (following-char) ?*) ! 176: (let ((buffer-read-only nil)) ! 177: (delete-char 1) ! 178: (insert ? ))) ! 179: (beginning-of-line)) ! 180: ! 181: (defun debugger-eval-expression (exp) ! 182: (interactive "xEval: ") ! 183: (save-excursion ! 184: (if (null (buffer-name debugger-old-buffer)) ! 185: ;; old buffer deleted ! 186: (setq debugger-old-buffer (current-buffer))) ! 187: (set-buffer debugger-old-buffer) ! 188: (eval-expression exp))) ! 189: ! 190: (defvar debugger-mode-map nil) ! 191: (if debugger-mode-map ! 192: nil ! 193: (let ((loop ? )) ! 194: (setq debugger-mode-map (make-keymap)) ! 195: (suppress-keymap debugger-mode-map) ! 196: (define-key debugger-mode-map "-" 'negative-argument) ! 197: (define-key debugger-mode-map "b" 'debugger-frame) ! 198: (define-key debugger-mode-map "c" 'debugger-continue) ! 199: (define-key debugger-mode-map "r" 'debugger-return-value) ! 200: (define-key debugger-mode-map "u" 'debugger-frame-clear) ! 201: (define-key debugger-mode-map "d" 'debugger-step-through) ! 202: (define-key debugger-mode-map "h" 'describe-mode) ! 203: (define-key debugger-mode-map "q" 'top-level) ! 204: (define-key debugger-mode-map "e" 'debugger-eval-expression) ! 205: (define-key debugger-mode-map " " 'next-line))) ! 206: ! 207: (put 'debugger-mode 'mode-class 'special) ! 208: ! 209: (defun debugger-mode () ! 210: "Mode for backtrace buffers, selected in debugger. ! 211: \\{debugger-mode-map} ! 212: For the r command, when in debugger due to frame being exited, ! 213: the value specified here will be used as the value of that frame. ! 214: ! 215: Note lines starting with * are frames that will ! 216: enter debugger when exited." ! 217: (kill-all-local-variables) ! 218: (setq major-mode 'debugger-mode) ! 219: (setq mode-name "Debugger") ! 220: (setq truncate-lines t) ! 221: (set-syntax-table emacs-lisp-mode-syntax-table) ! 222: (use-local-map debugger-mode-map)) ! 223: ! 224: (defun debug-on-entry (function) ! 225: "Request FUNCTION to invoke debugger each time it is called. ! 226: If the user continues, FUNCTION's execution proceeds. ! 227: Works by modifying the definition of FUNCTION, ! 228: which must be written in Lisp, not predefined. ! 229: Use `cancel-debug-on-entry' to cancel the effect of this command. ! 230: Redefining FUNCTION also does that." ! 231: (interactive "aDebug on entry (to function): ") ! 232: (let ((defn (symbol-function function))) ! 233: (if (eq (car defn) 'macro) ! 234: (fset function (cons 'macro (debug-on-entry-1 function (cdr defn) t))) ! 235: (fset function (debug-on-entry-1 function defn t)))) ! 236: function) ! 237: ! 238: (defun cancel-debug-on-entry (function) ! 239: "Undoes effect of debug-on-entry on FUNCTION." ! 240: (interactive "aCancel debug on entry (to function): ") ! 241: (let ((defn (symbol-function function))) ! 242: (if (eq (car defn) 'macro) ! 243: (fset function ! 244: (cons 'macro (debug-on-entry-1 function (cdr defn) nil))) ! 245: (fset function (debug-on-entry-1 function defn nil)))) ! 246: function) ! 247: ! 248: (defun debug-on-entry-1 (function defn flag) ! 249: (or (eq (car defn) 'lambda) ! 250: (error "%s not user-defined Lisp function." function)) ! 251: (let (tail prec) ! 252: (if (stringp (car (nthcdr 2 defn))) ! 253: (setq tail (nthcdr 3 defn) ! 254: prec (list (car defn) (car (cdr defn)) (car (cdr (cdr defn))))) ! 255: (setq tail (nthcdr 2 defn) ! 256: prec (list (car defn) (car (cdr defn))))) ! 257: (if (eq flag (equal (car tail) '(debug 'debug))) ! 258: nil ! 259: (if flag ! 260: (nconc prec (cons '(debug 'debug) tail)) ! 261: (nconc prec (cdr tail))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.