/[emacs]/emacs/lisp/emacs-lisp/debug.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/debug.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.74 by lute, Tue Mar 8 20:15:15 2005 UTC revision 1.75 by lute, Thu Mar 10 09:42:13 2005 UTC
# Line 97  This is to optimize `debugger-make-xrefs Line 97  This is to optimize `debugger-make-xrefs
97  This variable is used by `debugger-jump', `debugger-step-through',  This variable is used by `debugger-jump', `debugger-step-through',
98  and `debugger-reenable' to temporarily disable debug-on-entry.")  and `debugger-reenable' to temporarily disable debug-on-entry.")
99    
 ;; When you change this, you may also need to change the number of  
 ;; frames that the debugger skips.  
 (defconst debug-entry-code  
   '(if (or inhibit-debug-on-entry debugger-jumping-flag)  
        nil  
      (debug 'debug))  
   "Code added to a function to cause it to call the debugger upon entry.")  
   
100  ;;;###autoload  ;;;###autoload
101  (setq debugger 'debug)  (setq debugger 'debug)
102  ;;;###autoload  ;;;###autoload
# Line 200  first will be printed into the backtrace Line 192  first will be printed into the backtrace
192                    (kill-emacs))                    (kill-emacs))
193                  (if (eq (car debugger-args) 'debug)                  (if (eq (car debugger-args) 'debug)
194                      ;; Skip the frames for backtrace-debug, byte-code,                      ;; Skip the frames for backtrace-debug, byte-code,
195                      ;; and debug-entry-code.                      ;; and implement-debug-on-entry.
196                      (backtrace-debug 4 t))                      (backtrace-debug 4 t))
197                  (message "")                  (message "")
198                  (let ((standard-output nil)                  (let ((standard-output nil)
# Line 264  That buffer should be current already." Line 256  That buffer should be current already."
256                   (progn                   (progn
257                     (search-forward "\n  debug(")                     (search-forward "\n  debug(")
258                     (forward-line (if (eq (car debugger-args) 'debug)                     (forward-line (if (eq (car debugger-args) 'debug)
259                                       2  ; Remove debug-entry-code frame.                                       2  ; Remove implement-debug-on-entry frame.
260                                     1))                                     1))
261                     (point)))                     (point)))
262    (insert "Debugger entered")    (insert "Debugger entered")
# Line 432  removes itself from that hook." Line 424  removes itself from that hook."
424            (count 0))            (count 0))
425        (while (not (eq (cadr (backtrace-frame count)) 'debug))        (while (not (eq (cadr (backtrace-frame count)) 'debug))
426          (setq count (1+ count)))          (setq count (1+ count)))
427        ;; Skip debug-entry-code frame.        ;; Skip implement-debug-on-entry frame.
428        (when (member '(debug (quote debug)) (cdr (backtrace-frame (1+ count))))        (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count))))
429          (setq count (1+ count)))          (setq count (1+ count)))
430        (goto-char (point-min))        (goto-char (point-min))
431        (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")        (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
# Line 623  Complete list of commands: Line 615  Complete list of commands:
615    (use-local-map debugger-mode-map)    (use-local-map debugger-mode-map)
616    (run-mode-hooks 'debugger-mode-hook))    (run-mode-hooks 'debugger-mode-hook))
617    
618    ;; When you change this, you may also need to change the number of
619    ;; frames that the debugger skips.
620    (defun implement-debug-on-entry ()
621      "Conditionally call the debugger.
622    A call to this function is inserted by `debug-on-entry' to cause
623    functions to break on entry."
624      (if (or inhibit-debug-on-entry debugger-jumping-flag)
625          nil
626        (funcall debugger 'debug)))
627    
628  ;;;###autoload  ;;;###autoload
629  (defun debug-on-entry (function)  (defun debug-on-entry (function)
630    "Request FUNCTION to invoke debugger each time it is called.    "Request FUNCTION to invoke debugger each time it is called.
# Line 647  Redefining FUNCTION also cancels it." Line 649  Redefining FUNCTION also cancels it."
649        (debug-convert-byte-code function))        (debug-convert-byte-code function))
650    (or (consp (symbol-function function))    (or (consp (symbol-function function))
651        (error "Definition of %s is not a list" function))        (error "Definition of %s is not a list" function))
652    (fset function (debug-on-entry-1 function (symbol-function function) t))    (fset function (debug-on-entry-1 function t))
653    (or (memq function debug-function-list)    (or (memq function debug-function-list)
654        (push function debug-function-list))        (push function debug-function-list))
655    function)    function)
# Line 664  If argument is nil or an empty string, c Line 666  If argument is nil or an empty string, c
666             (if name (intern name)))))             (if name (intern name)))))
667    (if (and function (not (string= function "")))    (if (and function (not (string= function "")))
668        (progn        (progn
669          (let ((f (debug-on-entry-1 function (symbol-function function) nil)))          (let ((f (debug-on-entry-1 function nil)))
670            (condition-case nil            (condition-case nil
671                (if (and (equal (nth 1 f) '(&rest debug-on-entry-args))                (if (and (equal (nth 1 f) '(&rest debug-on-entry-args))
672                         (eq (car (nth 3 f)) 'apply))                         (eq (car (nth 3 f)) 'apply))
# Line 695  If argument is nil or an empty string, c Line 697  If argument is nil or an empty string, c
697                (setq body (cons (documentation function) body)))                (setq body (cons (documentation function) body)))
698            (fset function (cons 'lambda (cons (car contents) body)))))))            (fset function (cons 'lambda (cons (car contents) body)))))))
699    
700  (defun debug-on-entry-1 (function defn flag)  (defun debug-on-entry-1 (function flag)
701    (let ((tail defn))    (let* ((defn (symbol-function function))
702             (tail defn))
703      (if (subrp tail)      (if (subrp tail)
704          (error "%s is a built-in function" function)          (error "%s is a built-in function" function)
705        (if (eq (car tail) 'macro) (setq tail (cdr tail)))        (if (eq (car tail) 'macro) (setq tail (cdr tail)))
# Line 708  If argument is nil or an empty string, c Line 711  If argument is nil or an empty string, c
711        ;; Skip the interactive form.        ;; Skip the interactive form.
712        (when (eq 'interactive (car-safe (cadr tail)))        (when (eq 'interactive (car-safe (cadr tail)))
713          (setq tail (cdr tail)))          (setq tail (cdr tail)))
714        (unless (eq flag (equal (cadr tail) debug-entry-code))        (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry)))
715          ;; Add/remove debug statement as needed.          ;; Add/remove debug statement as needed.
716          (if flag          (if flag
717              (setcdr tail (cons debug-entry-code (cdr tail)))              (setcdr tail (cons '(implement-debug-on-entry) (cdr tail)))
718            (setcdr tail (cddr tail))))            (setcdr tail (cddr tail))))
719        defn)))        defn)))
720    

Legend:
Removed from v.1.74  
changed lines
  Added in v.1.75

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26