diff lisp/prim/debug.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents b82b59fe008d
children b9518feda344
line wrap: on
line diff
--- a/lisp/prim/debug.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/prim/debug.el	Mon Aug 13 09:02:59 2007 +0200
@@ -18,17 +18,11 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
-;;; Commentary:
-
-;; NB: There are lots of formatting changes in the XEmacs version. -sb
-
-;; This is a major mode documented in the Emacs manual.
+;;; Synched up with: FSF 19.30.
 
 ;;; Code:
 
@@ -53,14 +47,10 @@
 (defvar debugger-outer-last-command)
 (defvar debugger-outer-this-command)
 (defvar debugger-outer-unread-command-event)
-;; FSF: (defvar debugger-outer-unread-command-char)
-(defvar debugger-outer-unread-command-events)
 (defvar debugger-outer-last-input-event)
 (defvar debugger-outer-last-input-char)
 (defvar debugger-outer-last-input-time)
 (defvar debugger-outer-last-command-event)
-;; (defvar debugger-outer-last-nonmenu-event)
-;; (defvar debugger-outer-last-event-frame)
 (defvar debugger-outer-last-command-char)
 (defvar debugger-outer-standard-input)
 (defvar debugger-outer-standard-output)
@@ -76,12 +66,12 @@
 ;;;###autoload
 (defun debug (&rest debugger-args)
   "Enter debugger.  To return, type \\<debugger-mode-map>`\\[debugger-continue]'.
-Arguments are mainly for use when this is called from the internals
-of the evaluator.
-
-You may call with no args, or you may pass nil as the first arg and
-any other args you like.  In that case, the list of args after the
-first will be printed into the backtrace buffer."
+Arguments are mainly for use when this is called
+ from the internals of the evaluator.
+You may call with no args, or you may
+ pass nil as the first arg and any other args you like.
+ In that case, the list of args after the first will 
+ be printed into the backtrace buffer."
   (interactive)
   ;; XEmacs: it doesn't work to enter the debugger non-interactively
   ;; so just print out a backtrace and exit.
@@ -90,32 +80,32 @@
   (let (debugger-value
 	(debug-on-error nil)
 	(debug-on-quit nil)
-	(debug-on-signal nil)	; XEmacs
+	(debug-on-signal nil)
 	(debugger-buffer (let ((default-major-mode 'fundamental-mode))
 			   (get-buffer-create "*Backtrace*")))
 	;; #### I18N3 set the debugger-buffer to output-translating
 	(debugger-old-buffer (current-buffer))
 	(debugger-step-after-exit nil)
-	;; Don't keep reading from an executing kbd macro!
-	(executing-macro nil)
-	;; Save the outer values of these vars for the `e' command
+        ;; Don't keep reading from an executing kbd macro!
+        (executing-macro nil)
+        ;; Save the outer values of these vars for the `e' command
 	;; before we replace the values.
 	(debugger-outer-match-data (match-data))
 	(debugger-outer-load-read-function load-read-function)
 	(debugger-outer-overriding-local-map overriding-local-map)
 	;; FSFmacs (debugger-outer-track-mouse track-mouse)
-	(debugger-outer-last-command last-command)
-	(debugger-outer-this-command this-command)
-	(debugger-outer-unread-command-event unread-command-event)
-	(debugger-outer-unread-command-events unread-command-events)
-	(debugger-outer-last-input-event last-input-event)
-	(debugger-outer-last-input-char last-input-char)
-	(debugger-outer-last-input-time last-input-time)
-	(debugger-outer-last-command-event last-command-event)
-	(debugger-outer-last-command-char last-command-char)
-	(debugger-outer-standard-input standard-input)
-	(debugger-outer-standard-output standard-output)
-	(debugger-outer-cursor-in-echo-area cursor-in-echo-area))
+        (debugger-outer-last-command last-command)
+        (debugger-outer-this-command this-command)
+        (debugger-outer-unread-command-event unread-command-event)
+        (debugger-outer-last-input-event last-input-event)
+        (debugger-outer-last-input-char last-input-char)
+        (debugger-outer-last-input-time last-input-time)
+        (debugger-outer-last-command-event last-command-event)
+        (debugger-outer-last-command-char last-command-char)
+        (debugger-outer-standard-input standard-input)
+        (debugger-outer-standard-output standard-output)
+        (debugger-outer-cursor-in-echo-area cursor-in-echo-area)
+        )
     ;; Don't let these magic variables affect the debugger itself.
     (unwind-protect                     ;XEmacs change
 	(let ((last-command nil)
@@ -143,13 +133,12 @@
 	      (debugger-mode)
 	      (delete-region (point)
 			     (progn
-			       ;; XEmacs change
 			       (re-search-forward "\n[* ] debug(")
 			       (forward-line 1)
 			       (point)))
-	      (debugger-reenable)
 	      ;; lambda is for debug-on-call when a function call is next.
 	      ;; debug is for debug-on-entry function called.
+	      (debugger-reenable)
 	      (cond ((memq (car debugger-args) '(lambda debug))
 		     (insert "Entering:\n")
 		     (if (eq (car debugger-args) 'debug)
@@ -171,12 +160,13 @@
 		     (beginning-of-line))
 		    ;; Debugger entered for an error.
 		    ((eq (car debugger-args) 'error)
-		     (insert "Signaling: ")
+		     (insert "Signalling: ")
 		     (prin1 (nth 1 debugger-args) (current-buffer))
 		     (insert ?\n))
 		    ;; debug-on-call, when the next thing is an eval.
 		    ((eq (car debugger-args) t)
-		     (insert "Beginning evaluation of function call form:\n"))
+		     (insert
+		      "Beginning evaluation of function call form:\n"))
 		    ;; User calls debug directly.
 		    (t
 		     (prin1 (if (eq (car debugger-args) 'nil)
@@ -187,12 +177,11 @@
 	      (let ((inhibit-trace t)
 		    (standard-output nil)
 		    (buffer-read-only t))
-		(message "")
+		(message nil)
 		(recursive-edit)))
-	    ;; XEmacs change
 	    debugger-value))
-      ;; Kill or at least neuter the backtrace buffer, so that users
-      ;; don't try to execute debugger commands in an invalid context.
+	;; Kill or at least neuter the backtrace buffer, so that users
+	;; don't try to execute debugger commands in an invalid context.
       (if (get-buffer-window debugger-buffer 'visible)
 	    ;; Still visible despite the save-window-excursion?  Maybe it
 	    ;; it's in a pop-up frame.  It would be annoying to delete and
@@ -212,7 +201,6 @@
       (setq last-command debugger-outer-last-command)
       (setq this-command debugger-outer-this-command)
       (setq unread-command-event debugger-outer-unread-command-event)
-      (setq unread-command-event debugger-outer-unread-command-events)
       (setq last-input-event debugger-outer-last-input-event)
       (setq last-input-char debugger-outer-last-input-char)
       (setq last-input-time debugger-outer-last-input-time)
@@ -224,7 +212,7 @@
       (setq debug-on-next-call debugger-step-after-exit) ;do this last!
       )))
 
-;; XEmacs
+
 (defun debugger-exit ()
   (condition-case nil
       (let ((debug-on-error nil)
@@ -241,14 +229,12 @@
   (interactive)
   (setq debugger-step-after-exit t)
   (message "Proceeding, will debug on next eval or call.")
-  ;; XEmacs
   (debugger-exit))
 
 (defun debugger-continue ()
   "Continue, evaluating this expression without stopping."
   (interactive)
   (message "Continuing.")
-  ;; XEmacs
   (debugger-exit))
 
 (defun debugger-return-value (val)
@@ -261,7 +247,6 @@
   (prin1 debugger-value)
   (exit-recursive-edit))
 
-;; XEmacs: [Moved block]
 ;; Chosen empirically to account for all the frames
 ;; that will exist when debugger-frame is called
 ;; within the first one that appears in the backtrace buffer.
@@ -302,7 +287,7 @@
     (let ((opoint (point))
 	  (count 0))
       (goto-char (point-min))
-      ;; XEmacs:#### I18N3 will not localize properly!
+      ;; #### I18N3 will not localize properly!
       (if (or (equal (buffer-substring (point) (+ (point) 6))
 		     (gettext "Signal"))
 	      (equal (buffer-substring (point) (+ (point) 6))
@@ -359,16 +344,15 @@
 	(setq debugger-old-buffer (current-buffer)))
     (set-buffer debugger-old-buffer)
     (let ((last-command debugger-outer-last-command)
-	  (this-command debugger-outer-this-command)
-	  (unread-command-event debugger-outer-unread-command-event)
-	  (unread-command-event debugger-outer-unread-command-events)
-	  (last-input-event debugger-outer-last-input-event)
-	  (last-input-char debugger-outer-last-input-char)
-	  (last-input-time debugger-outer-last-input-time)
-	  (last-command-event debugger-outer-last-command-event)
-	  (last-command-char debugger-outer-last-command-char)
-	  (standard-input debugger-outer-standard-input)
-	  (standard-output debugger-outer-standard-output)
+          (this-command debugger-outer-this-command)
+          (unread-command-event debugger-outer-unread-command-event)
+          (last-input-event debugger-outer-last-input-event)
+          (last-input-char debugger-outer-last-input-char)
+          (last-input-time debugger-outer-last-input-time)
+          (last-command-event debugger-outer-last-command-event)
+          (last-command-char debugger-outer-last-command-char)
+          (standard-input debugger-outer-standard-input)
+          (standard-output debugger-outer-standard-output)
 	  (cursor-in-echo-area debugger-outer-cursor-in-echo-area)
 	  (overriding-local-map debugger-outer-overriding-local-map)
 	  (load-read-function debugger-outer-load-read-function))
@@ -389,24 +373,23 @@
               debugger-outer-standard-output standard-output
               debugger-outer-cursor-in-echo-area cursor-in-echo-area)))))
 
-(defvar debugger-mode-map nil)
-(if debugger-mode-map
-    nil
-  (let ((loop ? ))
-    (setq debugger-mode-map (make-keymap))
-    (suppress-keymap debugger-mode-map)
-    (define-key debugger-mode-map "-" 'negative-argument)
-    (define-key debugger-mode-map "b" 'debugger-frame)
-    (define-key debugger-mode-map "c" 'debugger-continue)
-    (define-key debugger-mode-map "j" 'debugger-jump)
-    (define-key debugger-mode-map "r" 'debugger-return-value)
-    (define-key debugger-mode-map "u" 'debugger-frame-clear)
-    (define-key debugger-mode-map "d" 'debugger-step-through)
-    (define-key debugger-mode-map "l" 'debugger-list-functions)
-    (define-key debugger-mode-map "h" 'describe-mode)
-    (define-key debugger-mode-map "q" 'top-level)
-    (define-key debugger-mode-map "e" 'debugger-eval-expression)
-    (define-key debugger-mode-map " " 'next-line)))
+(defvar debugger-mode-map
+  (let ((map (make-keymap)))
+    (set-keymap-name map 'debugger-mode-map)
+    (suppress-keymap map)
+    (define-key map "-" 'negative-argument)
+    (define-key map "b" 'debugger-frame)
+    (define-key map "c" 'debugger-continue)
+    (define-key map "j" 'debugger-jump)
+    (define-key map "r" 'debugger-return-value)
+    (define-key map "u" 'debugger-frame-clear)
+    (define-key map "d" 'debugger-step-through)
+    (define-key map "l" 'debugger-list-functions)
+    (define-key map "h" 'describe-mode)
+    (define-key map "q" 'top-level)
+    (define-key map "e" 'debugger-eval-expression)
+    (define-key map " " 'next-line)
+    map))
 
 (put 'debugger-mode 'mode-class 'special)
 
@@ -427,7 +410,7 @@
 \\{debugger-mode-map}"
   (kill-all-local-variables)    
   (setq major-mode 'debugger-mode)
-  (setq mode-name (gettext "Debugger"))	; XEmacs
+  (setq mode-name (gettext "Debugger"))
   (setq truncate-lines t)
   (set-syntax-table emacs-lisp-mode-syntax-table)
   (use-local-map debugger-mode-map))
@@ -459,12 +442,11 @@
 If argument is nil or an empty string, cancel for all functions."
   (interactive
    (list (let ((name
-		(completing-read "Cancel debug on entry (to function): "
-				 ;; Make an "alist" of the functions
+                (completing-read "Cancel debug on entry (to function): "
+                                 ;; Make an "alist" of the functions
 				 ;; that now have debug on entry.
-				 (mapcar 'list
-					 (mapcar 'symbol-name
-						 debug-function-list))
+				 (mapcar 'list (mapcar 'symbol-name
+                                                       debug-function-list))
 				 nil t nil)))
 	   (if name (intern name)))))
   (debugger-reenable)
@@ -504,8 +486,7 @@
       (let (tail prec)
 	(if (stringp (car (nthcdr 2 defn)))
 	    (setq tail (nthcdr 3 defn)
-		  prec (list (car defn) (car (cdr defn))
-			     (car (cdr (cdr defn)))))
+		  prec (list (car defn) (car (cdr defn)) (car (cdr (cdr defn)))))
 	  (setq tail (nthcdr 2 defn)
 		prec (list (car defn) (car (cdr defn)))))
 	(if (eq flag (equal (car tail) '(debug 'debug)))