![[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] / 43BSD / contrib / emacs / lisp|
Return to debug.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 ! root 1: ;; Debuggers and related commands for Emacs ! 2: ;; Copyright (C) 1985 Richard M. Stallman. ! 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 (generate-new-buffer "*Backtrace*")) ! 38: debugger-step-after-exit) ! 39: (unwind-protect ! 40: (save-excursion ! 41: (save-window-excursion ! 42: (pop-to-buffer debugger-buffer) ! 43: (erase-buffer) ! 44: (let ((standard-output (current-buffer)) ! 45: (print-length 50)) ! 46: (backtrace)) ! 47: (goto-char (point-min)) ! 48: (debugger-mode) ! 49: (delete-region (point) ! 50: (progn ! 51: (forward-sexp 8) ! 52: (forward-line 1) ! 53: (point))) ! 54: (cond ((memq (car debugger-args) '(lambda debug)) ! 55: (insert "Entering:\n") ! 56: (if (eq (car debugger-args) 'debug) ! 57: (progn ! 58: (backtrace-debug 4 t) ! 59: (delete-char 1) ! 60: (insert ?*) ! 61: (beginning-of-line)))) ! 62: ((eq (car debugger-args) 'exit) ! 63: (insert "Return value: ") ! 64: (setq debugger-value (nth 1 debugger-args)) ! 65: (prin1 debugger-value (current-buffer)) ! 66: (insert ?\n) ! 67: (delete-char 1) ! 68: (insert ? ) ! 69: (beginning-of-line)) ! 70: ((eq (car debugger-args) 'error) ! 71: (insert "Signalling: ") ! 72: (prin1 (nth 1 debugger-args) (current-buffer)) ! 73: (insert ?\n)) ! 74: ((eq (car debugger-args) t) ! 75: (insert "Beginning evaluation of function call form:\n")) ! 76: (t ! 77: (prin1 (if (eq (car debugger-args) 'nil) ! 78: (cdr debugger-args) debugger-args) ! 79: (current-buffer)) ! 80: (insert ?\n))) ! 81: (message "") ! 82: (let ((inhibit-trace t) ! 83: (standard-output nil) ! 84: (buffer-read-only t)) ! 85: (message "") ! 86: (recursive-edit)))) ! 87: ;; So that users do not try to execute debugger commands ! 88: ;; in an invalid context ! 89: (kill-buffer debugger-buffer) ! 90: (store-match-data debugger-match-data)) ! 91: (setq debug-on-next-call debugger-step-after-exit) ! 92: debugger-value)) ! 93: ! 94: (defun debugger-step-through () ! 95: "Proceed, stepping through subexpressions of this expression. ! 96: Enter another debugger on next entry to eval, apply or funcall." ! 97: (interactive) ! 98: (setq debugger-step-after-exit t) ! 99: (message "Proceding, will debug on next eval or call.") ! 100: (exit-recursive-edit)) ! 101: ! 102: (defun debugger-continue () ! 103: "Continue, evaluating this expression without stopping." ! 104: (interactive) ! 105: (message "Continuing.") ! 106: (exit-recursive-edit)) ! 107: ! 108: (defun debugger-return-value (val) ! 109: "Continue, specifying value to return. ! 110: This is only useful when the value returned from the debugger ! 111: will be used, such as in a debug on exit from a frame." ! 112: (interactive "XReturn value (evaluated): ") ! 113: (setq debugger-value val) ! 114: (princ "Returning " t) ! 115: (prin1 debugger-value) ! 116: (exit-recursive-edit)) ! 117: ! 118: (defun debugger-frame-number () ! 119: "Return number of frames in backtrace before the one point points at." ! 120: (save-excursion ! 121: (beginning-of-line) ! 122: (let ((opoint (point)) ! 123: (count 0)) ! 124: (goto-char (point-min)) ! 125: (if (or (equal (buffer-substring (point) (+ (point) 6)) ! 126: "Signal") ! 127: (equal (buffer-substring (point) (+ (point) 6)) ! 128: "Return")) ! 129: (progn ! 130: (search-forward ":") ! 131: (forward-sexp 1))) ! 132: (forward-line 1) ! 133: (while (progn ! 134: (forward-char 2) ! 135: (if (= (following-char) ?\() ! 136: (forward-sexp 1) ! 137: (forward-sexp 2)) ! 138: (forward-line 1) ! 139: (<= (point) opoint)) ! 140: (setq count (1+ count))) ! 141: count))) ! 142: ! 143: ;; Chosen empirically to account for all the frames ! 144: ;; that will exist when debugger-frame is called ! 145: ;; within the first one that appears in the backtrace buffer. ! 146: ;; Assumes debugger-frame is called from a key; ! 147: ;; will be wrong if it is called with Meta-x. ! 148: (defconst debugger-frame-offset 8 "") ! 149: ! 150: (defun debugger-frame () ! 151: "Request entry to debugger when this frame exits. ! 152: Applies to the frame whose line point is on in the backtrace." ! 153: (interactive) ! 154: (beginning-of-line) ! 155: (let ((level (debugger-frame-number))) ! 156: (backtrace-debug (+ level debugger-frame-offset) t)) ! 157: (if (= (following-char) ? ) ! 158: (let ((buffer-read-only nil)) ! 159: (delete-char 1) ! 160: (insert ?*))) ! 161: (beginning-of-line)) ! 162: ! 163: (defun debugger-frame-clear () ! 164: "Do not enter to debugger when this frame exits. ! 165: Applies to the frame whose line point is on in the backtrace." ! 166: (interactive) ! 167: (beginning-of-line) ! 168: (let ((level (debugger-frame-number))) ! 169: (backtrace-debug (+ level debugger-frame-offset) nil)) ! 170: (if (= (following-char) ?*) ! 171: (let ((buffer-read-only nil)) ! 172: (delete-char 1) ! 173: (insert ? ))) ! 174: (beginning-of-line)) ! 175: ! 176: ;; These two function names are equivalent except that ! 177: ;; debugger-eval-expression is not normally disabled. ! 178: (fset 'debugger-eval-expression 'eval-expression) ! 179: ! 180: (defvar debugger-mode-map nil) ! 181: (if debugger-mode-map ! 182: nil ! 183: (let ((loop ? )) ! 184: (setq debugger-mode-map (make-keymap)) ! 185: (suppress-keymap debugger-mode-map) ! 186: (define-key debugger-mode-map "-" 'negative-argument) ! 187: (define-key debugger-mode-map "b" 'debugger-frame) ! 188: (define-key debugger-mode-map "c" 'debugger-continue) ! 189: (define-key debugger-mode-map "r" 'debugger-return-value) ! 190: (define-key debugger-mode-map "u" 'debugger-frame-clear) ! 191: (define-key debugger-mode-map "d" 'debugger-step-through) ! 192: (define-key debugger-mode-map "h" 'describe-mode) ! 193: (define-key debugger-mode-map "q" 'top-level) ! 194: (define-key debugger-mode-map "e" 'debugger-eval-expression) ! 195: (define-key debugger-mode-map " " 'next-line))) ! 196: ! 197: (defun debugger-mode () ! 198: "Mode for backtrace buffers, selected in debugger. ! 199: \\{debugger-mode-map} ! 200: For the r command, when in debugger due to frame being exited, ! 201: the value specified here will be used as the value of that frame. ! 202: ! 203: Note lines starting with * are frames that will ! 204: enter debugger when exited." ! 205: (kill-all-local-variables) ! 206: (setq major-mode 'debugger-mode) ! 207: (setq mode-name "Debugger") ! 208: (setq truncate-lines t) ! 209: (set-syntax-table lisp-mode-syntax-table) ! 210: (use-local-map debugger-mode-map)) ! 211: ! 212: (defun debug-on-entry (function) ! 213: "Request FUNCTION to invoke debugger each time it is called. ! 214: If the user continues, FUNCTION's execution proceeds. ! 215: Works by modifying the definition of FUNCTION, ! 216: which must be written in Lisp, not predefined." ! 217: (interactive "aDebug on entry (to function): ") ! 218: (let ((defn (symbol-function function))) ! 219: (if (eq (car defn) 'macro) ! 220: (fset function (cons 'macro (debug-on-entry-1 function (cdr defn) t))) ! 221: (fset function (debug-on-entry-1 function defn t)))) ! 222: function) ! 223: ! 224: (defun cancel-debug-on-entry (function) ! 225: "Undoes effect of debug-on-entry on FUNCTION." ! 226: (interactive "aCancel debug on entry (to function): ") ! 227: (let ((defn (symbol-function function))) ! 228: (if (eq (car defn) 'macro) ! 229: (fset function (cons 'macro (debug-on-entry-1 function (cdr defn)) nil)) ! 230: (fset function (debug-on-entry-1 function defn nil)))) ! 231: function) ! 232: ! 233: (defun debug-on-entry-1 (function defn flag) ! 234: (or (eq (car defn) 'lambda) ! 235: (error "%s not user-defined Lisp function." function)) ! 236: (let (tail prec) ! 237: (if (stringp (car (nthcdr 2 defn))) ! 238: (setq tail (nthcdr 3 defn) ! 239: prec (list (car defn) (car (cdr defn)) (car (cdr (cdr defn))))) ! 240: (setq tail (nthcdr 2 defn) ! 241: prec (list (car defn) (car (cdr defn))))) ! 242: (if (eq flag (equal (car tail) '(debug 'debug))) ! 243: nil ! 244: (if flag ! 245: (nconc prec (cons '(debug 'debug) tail)) ! 246: (nconc prec (cdr tail))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.