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