Index: Apps/Debugger/clim-debugger.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Debugger/clim-debugger.lisp,v
retrieving revision 1.1
diff -u -r1.1 clim-debugger.lisp
--- Apps/Debugger/clim-debugger.lisp	26 Apr 2005 03:19:34 -0000	1.1
+++ Apps/Debugger/clim-debugger.lisp	11 May 2007 02:57:07 -0000
@@ -1,5 +1,5 @@
 ;;; (c) copyright 2004 by Peter Mechlenborg (metch@daimi.au.dk)
-
+;;; (c) copyright 2007 by Jeremy Rayman (jeremy.rayman@gmail.com)
  
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Library General Public
@@ -23,15 +23,6 @@
 ;;; by Slime. Because of Slime I hope that this works on other
 ;;; implementations than SBCL.
 
-
-;;;
-;;; COMPILATION:
-;;;
-;;; At the moment I just use Slime to compile and load this file (with
-;;; the command: C-c C-k) after I have loaded CLIM. Note: I have used 
-;;; the cvs version of Slime and McCLIM.
-;;;
-
 ;;;
 ;;; Test:
 ;;;
@@ -46,7 +37,7 @@
 ;;;   (clim-listener:run-listener :new-process t))
 
 ;;;
-;;; Problems/todo:
+;;; Problems/notes/todo:
 ;;;
 ;;; - Elliott Johnson is to be thanked for the nice scroll-bars, but
 ;;;   for some reason they don't remember their position when clicking
@@ -61,20 +52,13 @@
 ;;;   do this currently.
 ;;;
 ;;; - Goto source location is not supported, but I think this could be
-;;;   done through slime.
+;;;   done through slime (swank) .
 ;;;
 ;;; - Currently the restart chosen by the clim-debugger is returned
 ;;;   through the global variable *returned-restart*, this is not the
 ;;;   best solution, but I do not know how of a better way to return a
 ;;;   value from a clim frame, when it exits.
 ;;;
-;;; - There need to added keyboard shortcuts. 'q' should exit the
-;;;   debugger with an abort. '0', '1' and so forth should activate
-;;;   the restarts, like Slime. Maybe is should be possible to use the
-;;;   arrow keys as well. Then we have to add a notion of the current
-;;;   frame. Would this be useful?
-;;;
-
 
 (defpackage "CLIM-DEBUGGER"
   (:use  "CL-USER" "CLIM" "CLIM-LISP")
@@ -94,81 +78,179 @@
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;   Data model    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;   Class definitions   ;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass debugger-info ()
-  ((the-condition :accessor the-condition
-	          :initarg :the-condition)
-   (condition-message :accessor condition-message
-		      :initarg  :condition-message)
-   (type-of-condition :accessor type-of-condition
-	              :initarg  :type-of-condition)
-   (condition-extra :accessor condition-extra
-	            :initarg  :condition-extra)
-   (condition-references :accessor condition-references
-	                 :initarg  :condition-references)
-   (restarts :accessor restarts
-	     :initarg :restarts)
-   (backtrace :accessor backtrace
-	      :initarg :backtrace)))
-   
-(defclass minimized-stack-frame-view (textual-view)())
-(defclass maximized-stack-frame-view (textual-view)())
-
-(defparameter +minimized-stack-frame-view+ 
-  (make-instance 'minimized-stack-frame-view))
-(defparameter +maximized-stack-frame-view+ 
-  (make-instance 'maximized-stack-frame-view))
+  ((the-condition
+    :accessor the-condition
+    :initarg :the-condition)
+   (condition-message
+    :accessor condition-message
+    :initarg  :condition-message)
+   (type-of-condition
+    :accessor type-of-condition
+    :initarg  :type-of-condition)
+   (condition-extra
+    :accessor condition-extra
+    :initarg  :condition-extra)
+   (condition-references
+    :accessor condition-references
+    :initarg  :condition-references)
+   (restarts
+    :accessor restarts
+    :initarg :restarts)
+   (backtrace
+    :accessor backtrace
+    :initarg :backtrace))
+  (:documentation "A class that holds all the info about a condition."))
 
 (defclass stack-frame ()
-  ((clim-view       :accessor view :initform +minimized-stack-frame-view+)
-   (frame-string    :accessor frame-string
-		    :initarg  :frame-string)
-   (frame-no        :accessor frame-no
-		    :initarg :frame-no)
-   (frame-variables :accessor frame-variables
-		    :initarg :frame-variables)))
+  ((clim-view
+    :accessor view
+    :initform +minimized-stack-frame-view+)
+   (frame-string
+    :accessor frame-string
+    :initarg  :frame-string)
+   (frame-no
+    :accessor frame-no
+    :initarg :frame-no)
+   (frame-variables
+    :accessor frame-variables
+    :initarg :frame-variables)
+   (current-p
+    :accessor current-p
+    :initform nil)
+   (current-var
+    :accessor current-var
+    :initform 0))
+  (:documentation "A class that holds infomation about a single stack frame."))
+
+(defclass minimized-stack-frame-view (textual-view)()
+  (:documentation "Class indicating that a stack frame is minimized."))
+(defclass maximized-stack-frame-view (textual-view)()
+  (:documentation "Class indicating that a stack frame is maximized."))
+
+(defmethod maximized-stack-frame-view-p ((sf-no number))
+  (maximized-stack-frame-view-p (nth sf-no (backtrace *condition*))))
+(defmethod maximized-stack-frame-view-p ((sf stack-frame))
+  (eq +maximized-stack-frame-view+ (view sf)))
+
+(defmethod minimized-stack-frame-view-p ((sf-no number))
+  (minimized-stack-frame-view-p (nth sf-no (backtrace *condition*))))
+(defmethod minimized-stack-frame-view-p ((sf stack-frame))
+  (eq +minimized-stack-frame-view+ (view sf)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;   Global variables and support funtions   ;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defparameter *condition* nil
+  "Holds the condition currently being handled by the debugger.")
+
+(defun get-stack-frame (i &optional (debug-info *condition*))
+  (nth i (backtrace debug-info)))
+
+
+(defparameter *current-stack-frame* nil
+  "An index in the list of stack frames, pointing out the current stack frame.")
+
+(defun move-current-stack-var (i)
+  (with-accessors ((cv current-var) (fvs frame-variables))
+      (get-stack-frame *current-stack-frame*)
+    (when (and (>= (+ i cv) 0)
+               (<= (+ i cv) (1- (length fvs))))
+      (incf cv i))))
+
+(defun maximize-current-var (frame-no)
+  (setf (current-var (get-stack-frame frame-no))
+        (1- (length (frame-variables (get-stack-frame frame-no))))))
+
+(defun minimize-current-var (frame-no)
+  (setf (current-var (get-stack-frame frame-no)) 0))
+
+(defun swap-current-info (old new &key adjust-var-pos)
+  (setf (current-p (get-stack-frame old)) nil)
+  (setf *current-stack-frame* new)
+  (setf (current-p (get-stack-frame new)) t)
+  (when (and adjust-var-pos (maximized-stack-frame-view-p (get-stack-frame new)))
+    (cond ((> old new) (maximize-current-var new))
+          ((> new old) (minimize-current-var new)))))
+
+(defun move-current-stack-frame (i)
+  (let ((ii (+ i *current-stack-frame*)))
+    (when (>= ii (length (backtrace *condition*)))
+      (expand-backtrace *condition* 10))
+    (let ((iii (min (1- (length (backtrace *condition*)))
+                    (max 0 ii))))
+      (swap-current-info *current-stack-frame* iii :adjust-var-pos t))))
+
+(defun increase-current-stack-frame ()
+  (if (maximized-stack-frame-view-p *current-stack-frame*)
+      (unless (move-current-stack-var 1)
+        (move-current-stack-frame 1))
+      (move-current-stack-frame 1)))
+
+(defun decrease-current-stack-frame ()
+  (if (maximized-stack-frame-view-p *current-stack-frame*)
+      (unless (move-current-stack-var -1)
+        (move-current-stack-frame -1))
+      (move-current-stack-frame -1)))
 
-(defun compute-backtrace (start end)
-  (loop for frame    in   (swank-backend::compute-backtrace start end)
-	for frame-no from 0
-	collect (make-instance
-		 'stack-frame
-		 :frame-string    (let ((*print-pretty* nil))
-				    (with-output-to-string (stream) 
-				      (swank-backend::print-frame frame stream)))
-		 :frame-no        frame-no
-		 :frame-variables (swank-backend::frame-locals frame-no))))
+
+(defparameter *default-backtrace-length* 20
+  "Number of frames to present in the backtrace.")
+
+(defparameter *more-backtraces* nil
+  "When nil the backtrace is complete.")
 
 (defmethod expand-backtrace ((info debugger-info) (value integer))
   (with-slots (backtrace) info
-    (setf backtrace (compute-backtrace 0 (+ (length backtrace) 10)))))
+    (let ((old (length backtrace)))
+      (setf backtrace (concatenate 'list backtrace
+                                   (compute-backtrace (length backtrace)
+                                                      (+ (length backtrace) value))))
+      (when (= old (length backtrace))
+        (setf *more-backtraces* nil)
+        nil))))
+
+(defun compute-backtrace (start end)
+  (loop for frame    in   (swank-backend::compute-backtrace start end)
+     for frame-no from 0
+     collect (make-instance
+              'stack-frame
+              :frame-string    (let ((*print-pretty* nil))
+                                 (with-output-to-string (stream) 
+                                   (swank-backend::print-frame frame stream)))
+              :frame-no        frame-no
+              :frame-variables (swank-backend::frame-locals frame-no))))
+
+
+(defvar +minimized-stack-frame-view+ 
+  (make-instance 'minimized-stack-frame-view))
+(defvar +maximized-stack-frame-view+ 
+  (make-instance 'maximized-stack-frame-view))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   CLIM stuff   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defclass debugger-pane (application-pane)
-  ((condition-info :reader condition-info :initarg :condition-info)))
+(defclass debugger-pane (application-pane) ())
 
-;; FIXME - These two variables should be removed!
-;; Used to return the chosen reatart in the debugger.
+;; FIXME - This variable should be removed!  Used to return the chosen
+;; restart in the debugger.
 (defparameter *returned-restart* nil)
 
-;; Used to provide the clim frame with the condition info that
-;; triggered the debugger.
-(defparameter *condition* nil)
-
 (defun make-debugger-pane ()
   (with-look-and-feel-realization ((frame-manager *application-frame*)
-				   *application-frame*) 
-    (make-pane 'debugger-pane 
-	       :condition-info *condition*
-	       :display-function #'display-debugger
-	       :end-of-line-action :allow
-	       :end-of-page-action :scroll)))
+                                   *application-frame*) 
+    (make-pane 'debugger-pane
+               :display-function #'display-debugger
+               :end-of-line-action :allow
+               :end-of-page-action :scroll
+               :incremental-redisplay t)))
 
 (define-application-frame clim-debugger ()
   ()
@@ -187,7 +269,7 @@
 ;;;   Presentation types   ;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-presentation-type stack-frame () :inherit-from 't)
+(define-presentation-type stack-frame ())
 (define-presentation-type restart     ())
 (define-presentation-type more-type   ())
 (define-presentation-type inspect     ())
@@ -199,32 +281,103 @@
 
 (define-clim-debugger-command (com-more :name "More backtraces")
     ((pane 'more-type))
-  (expand-backtrace (condition-info pane) 10))
+  (declare (ignore pane))
+  (expand-backtrace *condition* 10))
+
+(define-clim-debugger-command (com-invoke-inspector-on-current :keystroke #\Newline)
+    ()
+  (when (maximized-stack-frame-view-p (get-stack-frame *current-stack-frame*))
+    (clouseau:inspector (nth (current-var (get-stack-frame *current-stack-frame*))
+                             (frame-variables (get-stack-frame *current-stack-frame*))))))
 
 (define-clim-debugger-command (com-invoke-inspector :name "Invoke inspector")
     ((obj 'inspect))
   (clouseau:inspector obj))
 
-(define-clim-debugger-command (com-refresh :name "Refresh" :menu t) ()
-  (change-space-requirements (frame-panes *application-frame*)))
+(define-clim-debugger-command (com-quit :name "Quit" :menu t :keystroke #\q)
+    ()
+  (frame-exit *application-frame*))
 
-(define-clim-debugger-command (com-quit :name "Quit" :menu t) ()
+(define-clim-debugger-command (com-abort :name "Abort" :menu t :keystroke #\a)
+    ()
+  (setf *returned-restart* 'abort)
   (frame-exit *application-frame*))
 
+(define-clim-debugger-command (com-continue :name "Continue" :menu nil :keystroke #\c)
+    ()
+  (when (find-restart 'continue (the-condition *condition*))
+    (setf *returned-restart* 'continue)
+    (frame-exit *application-frame*)))
+
+(define-clim-debugger-command (com-about :name "About" :menu t)
+    ()
+  (com-invoke-restart (find-restart 'about (the-condition *condition*))))
+
 (define-clim-debugger-command (com-invoke-restart :name "Invoke restart")
     ((restart 'restart))
   (setf *returned-restart* restart)
   (frame-exit *application-frame*))
 
 (define-clim-debugger-command (com-toggle-stack-frame-view 
-			       :name "Toggle stack frame view")
+                               :name "Toggle stack frame view")
     ((stack-frame 'stack-frame))
   (progn
     (if (eq +minimized-stack-frame-view+ (view stack-frame))
-	(setf (view stack-frame) +maximized-stack-frame-view+)
-	(setf (view stack-frame) +minimized-stack-frame-view+))
+        (setf (view stack-frame) +maximized-stack-frame-view+)
+        (setf (view stack-frame) +minimized-stack-frame-view+))
+    (swap-current-info *current-stack-frame*
+                       (position stack-frame (backtrace *condition*)
+                                 :test #'eq))
     (change-space-requirements (frame-panes *application-frame*))))
 
+(define-clim-debugger-command (com-toggle-current-stack-frame-view 
+                               :name "Toggle current stack frame view"
+                               :keystroke #\Space)
+    ()
+  (com-toggle-stack-frame-view (nth *current-stack-frame* (backtrace *condition*))))
+
+(define-clim-debugger-command (com-move-current-down 
+                               :name "Move current stack frame down"
+                               :keystroke :down)
+    ()
+  (increase-current-stack-frame))
+
+(define-clim-debugger-command (com-move-current-up
+                               :name "Move current stack frame up"
+                               :keystroke :up)
+    ()
+  (decrease-current-stack-frame))
+
+
+(define-clim-debugger-command (com-invoke-restart-number :name "Invoke restart by number")
+    ((restart-number 'integer :prompt "Restart number"))
+  (let ((restart (nth restart-number (restarts *condition*))))        
+    (when restart 
+      (com-invoke-restart restart))))
+  
+
+;; Fixme: There must be a better way to do this (maybe a macro) !!
+(define-clim-debugger-command (com-invoke-restart-0 :name "Invoke restart number 0" :keystroke #\0) () 
+  (com-invoke-restart-number 0))
+(define-clim-debugger-command (com-invoke-restart-1 :name "Invoke restart number 1" :keystroke #\1) ()
+  (com-invoke-restart-number 1))
+(define-clim-debugger-command (com-invoke-restart-2 :name "Invoke restart number 2" :keystroke #\2) ()
+  (com-invoke-restart-number 2))
+(define-clim-debugger-command (com-invoke-restart-3 :name "Invoke restart number 3" :keystroke #\3) ()
+  (com-invoke-restart-number 3))
+(define-clim-debugger-command (com-invoke-restart-4 :name "Invoke restart number 4" :keystroke #\4) ()
+  (com-invoke-restart-number 4))
+(define-clim-debugger-command (com-invoke-restart-5 :name "Invoke restart number 5" :keystroke #\5) ()
+  (com-invoke-restart-number 5))
+(define-clim-debugger-command (com-invoke-restart-6 :name "Invoke restart number 6" :keystroke #\6) ()
+  (com-invoke-restart-number 6))
+(define-clim-debugger-command (com-invoke-restart-7 :name "Invoke restart number 7" :keystroke #\7) ()
+  (com-invoke-restart-number 7))
+(define-clim-debugger-command (com-invoke-restart-8 :name "Invoke restart number 8" :keystroke #\8) ()
+  (com-invoke-restart-number 8))
+(define-clim-debugger-command (com-invoke-restart-9 :name "Invoke restart number 9" :keystroke #\9) ()
+  (com-invoke-restart-number 9))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   Command translators   ;;;;;;;;;;;;;;;;;;;;;
@@ -232,22 +385,22 @@
 
 (define-presentation-to-command-translator more-backtraces
     (more-type com-more clim-debugger :gesture :select)
-    (object)
+	(object)
   (list object))
 
 (define-presentation-to-command-translator invoke-inspector
     (inspect com-invoke-inspector clim-debugger :gesture :select)
-    (object)
+	(object)
   (list object))
 
 (define-presentation-to-command-translator toggle-stack-frame-view
     (stack-frame com-toggle-stack-frame-view clim-debugger :gesture :select)
-    (object)
+	(object)
   (list object))
 
 (define-presentation-to-command-translator invoke-restart
     (restart com-invoke-restart clim-debugger :gesture :select)
-    (object)
+	(object)
   (list object))
 
 
@@ -257,119 +410,129 @@
 
 (defun std-form (pane first second &key (family :sans-serif))
   (formatting-row 
-      (pane)
-    (with-text-family (pane :sans-serif)
-      (formatting-cell (pane) (bold (pane) (format t "~A" first))))
-    (formatting-cell (pane)
-      (with-text-family (pane family) 
-       (format t "~A" second)))))
+	  (pane)
+	(with-text-family (pane :sans-serif)
+	  (formatting-cell (pane) (bold (pane) (format pane "~A" first))))
+	(formatting-cell (pane)
+	  (with-text-family (pane family) 
+		(format pane "~A" second)))))
 
 (defun display-debugger (frame pane)
-  (let ((*standard-output* pane))
-    (formatting-table (pane)
-      (std-form pane "Condition type:" (type-of-condition (condition-info
-							     pane)))
-      (std-form pane "Description:"    (condition-message (condition-info
-                                                            pane)))
-      (when (condition-extra (condition-info pane))
-        (std-form pane "Extra:" (condition-extra (condition-info pane))
-                  :family :fix))
-      (when (condition-references (condition-info pane))
-        (std-form pane "References:" (condition-references (condition-info
-                                                            pane))
-                  :family :fix)))
-    (fresh-line)
-    
-    (with-text-family (pane :sans-serif)
-      (bold (pane) (format t "Restarts:")))
-    (fresh-line)
-    (format t " ")
-    (formatting-table 
-	(pane)
-      (loop for r in (restarts (condition-info pane))
-        do (formatting-row (pane)
-              (with-output-as-presentation (pane r 'restart)
-                (formatting-cell (pane)
-                  (format pane "~A" (restart-name r)))
-              
-                (formatting-cell (pane)
-                  (with-text-family (pane :sans-serif)
-                    (format pane "~A" r)))))))
-    (fresh-line)
-    (display-backtrace frame pane)
-    (change-space-requirements pane
-			      :width (bounding-rectangle-width (stream-output-history pane))
-			      :height (bounding-rectangle-height (stream-output-history pane)))))
+  (formatting-table (pane)
+	(std-form pane "Condition type:" (type-of-condition *condition*))
+	(std-form pane "Description:"    (condition-message *condition*))
+	(when (condition-extra *condition*)
+	  (std-form pane "Extra:" (condition-extra *condition*)
+				:family :fix))
+	(when (condition-references *condition*)
+	  (std-form pane "References:" (condition-references *condition*)
+				:family :fix)))
+  (fresh-line)
+  
+  (with-text-family (pane :sans-serif)
+    (bold (pane) (format pane "Restarts:")))
+  (fresh-line)
+  (format pane " ")
+  (formatting-table 
+	  (pane)
+	(loop for r in (restarts *condition*)
+	   for i from 0
+	   do (formatting-row (pane)
+			(bold (pane) (formatting-cell (pane)
+						   (format pane "~A: " i)))
+			(with-output-as-presentation (pane r 'restart)
+			  (formatting-cell (pane)
+				(format pane "~A" (restart-name r)))
+         
+			  (formatting-cell (pane)
+				(with-text-family (pane :sans-serif)
+				  (format pane "~A" r)))))))
+  (fresh-line)
+  (display-backtrace frame pane)
+  (change-space-requirements pane
+                             :width (bounding-rectangle-width (stream-output-history pane))
+                             :height (bounding-rectangle-height (stream-output-history pane))))
 
+(defun foo (a b c) (list* (+ a b) c))
 
 (defun display-backtrace (frame pane)
   (declare (ignore frame)) 
   (with-text-family (pane :sans-serif)
-    (bold (pane) (format t "Backtrace:")))
+    (bold (pane) (format pane "Backtrace:")))
   (fresh-line)
-  (format t " ")
+  (format pane " ")
   (formatting-table 
-      (pane)
-    (loop for stack-frame in (backtrace (condition-info pane))
-	  for i from 0
-	  do (formatting-row (pane)
-               (with-output-as-presentation (pane stack-frame 'stack-frame)
-                 (bold (pane) (formatting-cell (pane) (format t "~A: " i)))
-                 (formatting-cell (pane)
-                   (present stack-frame 'stack-frame 
-                            :view (view stack-frame))))))
-    (when (>= (length (backtrace (condition-info pane))) 20)
-      (formatting-row (pane)
-        (formatting-cell (pane))
-        (formatting-cell (pane)
-          (bold (pane)
-            (present pane 'more-type)))))))
+	  (pane)
+	(loop for stack-frame in (backtrace *condition*)
+	   for i from 0
+	   do (formatting-row (pane)
+			(bold (pane) (formatting-cell (pane) (format pane "~A:" i)))
+			(if (and (current-p stack-frame)
+					 (minimized-stack-frame-view-p stack-frame))
+				(bold (pane) (formatting-cell (pane) (format pane "-->")))
+				(bold (pane) (formatting-cell (pane) (format pane "   "))))
+			(with-output-as-presentation (pane stack-frame 'stack-frame)
+			  (formatting-cell (pane)
+				(present stack-frame 'stack-frame 
+						 :view (view stack-frame))))))
+	(when *more-backtraces*
+	  (formatting-row (pane)
+		(formatting-cell (pane))
+		(formatting-cell (pane))
+		(formatting-cell (pane)
+		  (bold (pane)
+			(present pane 'more-type)))))))
 
 
 (define-presentation-method present (object (type stack-frame) stream
-				     (view minimized-stack-frame-view)
-				     &key acceptably for-context-type)
+                                            (view minimized-stack-frame-view)
+                                            &key acceptably for-context-type)
   (declare (ignore acceptably for-context-type))
-  (format t "~A  " (frame-string object)))
+  (format stream "~A  " (frame-string object)))
 
 (define-presentation-method present (object (type stack-frame) stream
-				     (view maximized-stack-frame-view)
-				     &key acceptably for-context-type)
+                                            (view maximized-stack-frame-view)
+                                            &key acceptably for-context-type)
   (declare (ignore acceptably for-context-type))
   (progn
     (princ (frame-string object) stream)
     (fresh-line)
     (with-text-family (stream :sans-serif)
-      (bold (stream) (format t "  Locals:")))
+      (bold (stream) (format stream "  Locals:")))
     (fresh-line)
-    (format t "     ")
+    (format stream "     ")
     (formatting-table 
-     (stream)
-     (loop for (name n identifier id value val) in (frame-variables object)
-	   do (formatting-row 
-	       (stream)
-	       (formatting-cell (stream) (format t "~A" n))
-	       (formatting-cell (stream) (format t "="))
-	       (formatting-cell (stream) (present val 'inspect)))))
+		(stream)
+	  (loop for (name n identifier id value val) in (frame-variables object)
+		 for i from 0
+		 do (formatting-row 
+				(stream)
+			  (if (and (current-p object)
+					   (= i (current-var object)))
+				  (bold (stream) (formatting-cell (stream) (format stream "-->")))
+				  (bold (stream) (formatting-cell (stream) (format stream "   "))))
+			  (formatting-cell (stream) (format stream "~A" n))
+			  (formatting-cell (stream) (format stream "="))
+			  (formatting-cell (stream) (present val 'inspect)))))
     (fresh-line)))
 
 (define-presentation-method present (object (type restart) stream
-				     (view textual-view)
-				     &key acceptably for-context-type)
+                                            (view textual-view)
+                                            &key acceptably for-context-type)
   (declare (ignore acceptably for-context-type))
-  (bold (stream) (format t "~A" (restart-name object))))
+  (bold (stream) (format stream "~A" (restart-name object))))
 
 (define-presentation-method present (object (type more-type) stream
-				     (view textual-view)
-				     &key acceptably for-context-type)
+                                            (view textual-view)
+                                            &key acceptably for-context-type)
   (declare (ignore acceptably for-context-type))
-  (bold (stream) (format t "--- MORE ---")))
+  (bold (stream) (format stream "--- MORE ---")))
 
 (define-presentation-method present (object (type inspect) stream
-				     (view textual-view)
-				     &key acceptably for-context-type)
+                                            (view textual-view)
+                                            &key acceptably for-context-type)
   (declare (ignore acceptably for-context-type))
-  (format t "~A" object))
+  (format stream "~A" object))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -380,26 +543,29 @@
   (swank-backend::call-with-debugging-environment 
    (lambda ()
      (unwind-protect
-	  (progn 
-	    (setf 
-	     *condition* 
-	     (make-instance 
-	      'debugger-info
-	      :the-condition        condition
-	      :type-of-condition    (type-of condition)
-	      :condition-message    (swank::safe-condition-message condition)
-	      :condition-extra      (swank::condition-extras       condition)
-	      :condition-references (swank::condition-references   condition)
-	      :restarts             (compute-restarts)
-	      :backtrace            (compute-backtrace 0 20)))
-	    (run-debugger-frame))
+          (let ((*current-stack-frame* 0)
+                (*more-backtraces* t)
+                (*condition* 
+                 (make-instance 
+                  'debugger-info
+                  :the-condition        condition
+                  :type-of-condition    (type-of condition)
+                  :condition-message    (swank::safe-condition-message condition)
+                  :condition-extra      (swank::condition-extras       condition)
+                  :condition-references (swank::condition-references   condition)
+                  :restarts             (compute-restarts)
+                  :backtrace            (compute-backtrace 0 *default-backtrace-length*))))
+            (if (<= (length (backtrace *condition*)) *default-backtrace-length*)
+                (setf *more-backtraces* nil))
+            (setf *current-stack-frame* 0)
+            (setf (current-p (get-stack-frame *current-stack-frame*)) t)
+            (run-debugger-frame))
        (let ((restart *returned-restart*))
-	 (setf *returned-restart* nil)
-	 (setf *condition* nil)
-	 (if restart
-	     (let ((*debugger-hook* me-or-my-encapsulation))
-	       (invoke-restart-interactively restart))
-	     (abort)))))))
+         (setf *returned-restart* nil)
+         (if restart
+             (let ((*debugger-hook* me-or-my-encapsulation))
+               (invoke-restart-interactively restart))
+             (abort)))))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -413,3 +579,4 @@
        (make-condition 'simple-error 
                        :format-control "Debugger test")))))
 
+
