/etc/host.conf: line 24: bad command `mdns off'
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	28 Apr 2006 14:41:33 -0000
@@ -132,14 +132,14 @@
 
 (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))))
+     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))))
 
 (defmethod expand-backtrace ((info debugger-info) (value integer))
   (with-slots (backtrace) info
@@ -151,7 +151,19 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass debugger-pane (application-pane)
-  ((condition-info :reader condition-info :initarg :condition-info)))
+  ((condition-info
+    :reader condition-info
+    :initarg :condition-info)
+   (selected-stack-frame-index
+    :accessor selected-stack-frame-index
+    :initarg :selected-strackframe-index
+    :type 'integer
+    :initform 0)
+   (presentation-hashmap
+    :accessor presentation-hash-table
+    :initarg :presentation-hash-tablen
+    :type 'hash-table
+    :initform (make-hash-table))))
 
 ;; FIXME - These two variables should be removed!
 ;; Used to return the chosen reatart in the debugger.
@@ -173,9 +185,15 @@
 (define-application-frame clim-debugger ()
   ()
   (:panes
-   (debugger-pane (make-debugger-pane)))
+   (debugger-pane (make-debugger-pane))
+   (interactor :interactor
+               :max-height 100)
+   (pointer-doc :pointer-documentation))
   (:layouts
-   (default (vertically () (scrolling () debugger-pane))))
+   (default (vertically ()
+              (scrolling () debugger-pane)
+              interactor
+              pointer-doc)))
   (:geometry :height 600 :width 800))
 
 (defun run-debugger-frame ()
@@ -192,26 +210,119 @@
 (define-presentation-type more-type   ())
 (define-presentation-type inspect     ())
 
+(defun highlight-selected-stack-frame (debugger-pane)
+  "Highlight the presentation associated with the currently
+  selected stack frame."
+  (funcall-presentation-generic-function
+   highlight-presentation
+   'stack-frame
+   (gethash (elt (backtrace
+                  (condition-info debugger-pane))
+                 (selected-stack-frame-index
+                  debugger-pane))
+            (presentation-hash-table debugger-pane))
+   debugger-pane
+   :highlight))
+
+(defun unhighlight-selected-stack-frame (debugger-pane)
+  "Unhighlight the presentation associated with the currently
+  selected stack frame."
+  (funcall-presentation-generic-function
+   highlight-presentation
+   'stack-frame
+   (gethash (elt (backtrace
+                  (condition-info debugger-pane))
+                 (selected-stack-frame-index
+                  debugger-pane))
+            (presentation-hash-table debugger-pane))
+   debugger-pane
+   :unhighlight))
+
+(define-presentation-method highlight-presentation ((type stack-frame) record (stream debugger-pane) (state (eql :highlight)))
+  (declare (ignore state stream))
+  (unhighlight-selected-stack-frame stream)
+  ;; List this presentation as the currently selected.
+  (setf (selected-stack-frame-index stream)
+        (position (presentation-object record)
+                  (backtrace (condition-info stream))))
+  ;; Unhighlight all other presentations.
+  
+  (call-next-method))
+
+(define-presentation-method present (object (type stack-frame) stream
+                                            (view minimized-stack-frame-view)
+                                            &key acceptably for-context-type)
+  (declare (ignore acceptably for-context-type))
+  (format t "~A  " (frame-string object)))
+
+(define-presentation-method present (object (type stack-frame) stream
+                                            (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:")))
+    (fresh-line)
+    (format t "     ")
+    (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)))))
+    (terpri stream)))
+
+(define-presentation-method present (object (type restart) stream
+                                            (view textual-view)
+                                            &key acceptably for-context-type)
+  (declare (ignore acceptably for-context-type))
+  (bold (stream) (format t "~A" (restart-name object))))
+
+(define-presentation-method present (object (type more-type) stream
+                                            (view textual-view)
+                                            &key acceptably for-context-type)
+  (declare (ignore acceptably for-context-type))
+  (bold (stream) (format t "--- MORE ---")))
+
+(define-presentation-method present (object (type inspect) stream
+                                            (view textual-view)
+                                            &key acceptably for-context-type)
+  (declare (ignore acceptably for-context-type))
+  (format t "~A" object))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   Commands   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-clim-debugger-command (com-more :name "More backtraces")
+(define-clim-debugger-command (com-more
+                               :name "More backtraces")
     ((pane 'more-type))
   (expand-backtrace (condition-info pane) 10))
 
-(define-clim-debugger-command (com-invoke-inspector :name "Invoke inspector")
+(define-clim-debugger-command (com-invoke-inspector
+                               :name "Invoke inspector")
     ((obj 'inspect))
-  (clouseau:inspector obj))
+  (clouseau:inspector obj :new-process t))
 
-(define-clim-debugger-command (com-refresh :name "Refresh" :menu t) ()
+(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) ()
+(define-clim-debugger-command (com-quit
+                               :name "Quit"
+                               :menu t)
+    ()
   (frame-exit *application-frame*))
 
-(define-clim-debugger-command (com-invoke-restart :name "Invoke restart")
+(define-clim-debugger-command (com-invoke-restart
+                               :name "Invoke restart")
     ((restart 'restart))
   (setf *returned-restart* restart)
   (frame-exit *application-frame*))
@@ -225,6 +336,148 @@
 	(setf (view stack-frame) +minimized-stack-frame-view+))
     (change-space-requirements (frame-panes *application-frame*))))
 
+(define-clim-debugger-command (com-eval-in-frame
+			       :name "Eval in frame")
+    ((stack-frame 'stack-frame)
+     &key 
+     (code 'expression
+           :prompt "code"
+           :default (accept 'expression)))
+  (setf swank::*buffer-package*
+        *package*
+        swank::*buffer-readtable*
+        *readtable*)
+  (print (swank:eval-string-in-frame
+          (write-to-string code)
+          (frame-no stack-frame))))
+
+;;; We want to be able to invoke restarts with the 1-9 letters on the
+;;; keyboard.
+
+(define-clim-debugger-command
+    (com-invoke-restart-by-number
+     :name "Invoke numbered restart")
+    ((number 'integer))
+  ;; `number' is the number of the restart to invoke. This
+  ;; is simply used as an index into a list.
+  (let* ((debugger-pane
+          (get-frame-pane *application-frame* 'debugger-pane))
+         (restarts
+          (restarts
+           (condition-info debugger-pane)))
+         (selected-restart (nth number restarts)))
+    ;; If the restart is not valid, we just ignore the command.
+    (when selected-restart 
+      (setf *returned-restart* selected-restart)
+      (frame-exit *application-frame*))))
+
+;;; We associate keystrokes in the interval 0-9 to calls to
+;;; `clim-invoke-restart' with the keystroke as argument. Is this a
+;;; kludge? I couln't find a better way to do it.
+
+;; Define a macro for convenience.
+
+(defmacro keybind-restart-commands (n)
+  "Associate the numeric keys in the interval 0-N with a call to
+`clim-invoke-restart' with the relevant number as argument."
+  `(progn
+     ,@(loop for r from 0 upto n
+          collecting
+          `(add-command-to-command-table
+            '(com-invoke-restart-by-number ,r)
+            'clim-debugger
+            :keystroke '(,(code-char (+ (char-code #\0) r)))))))
+
+(keybind-restart-commands 9)
+
+;; We also define an abort-command to permit quick exit.
+
+(define-clim-debugger-command
+    (com-invoke-abort-restart
+     :name "Invoke abort restart"
+     :keystroke (#\q))
+    ()
+  (setf *returned-restart* nil)
+  (frame-exit *application-frame*))
+
+;; We want to be able to navigate the list of stack frames 
+;; with the keyboard.
+
+(define-clim-debugger-command
+    (com-next-stack-frame
+     :name "Next stack-frame"
+     :keystroke (#\n :control))
+    ()
+  (let ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane)))
+    (when (< (selected-stack-frame-index debugger-pane)
+             (1- (length (backtrace (condition-info debugger-pane)))))
+      (incf (selected-stack-frame-index debugger-pane)))))
+
+(add-command-to-command-table
+ 'com-next-stack-frame
+ 'clim-debugger
+ :errorp nil
+ :keystroke '(#\n))
+
+(define-clim-debugger-command
+    (com-prev-stack-frame
+     :name "Previous stack-frame"
+     :keystroke (#\p :control))
+    ()
+  (let ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane)))
+    (when (> (selected-stack-frame-index debugger-pane) 0)
+      (decf (selected-stack-frame-index debugger-pane)))))
+
+(add-command-to-command-table
+ 'com-prev-stack-frame
+ 'clim-debugger
+ :errorp nil
+ :keystroke '(#\p))
+
+(define-clim-debugger-command
+    (com-toggle-selected-stack-frame-index-view
+     :name "Toggle view of selected stack-frame"
+     :keystroke (#\e))
+    ()
+  (let* ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane))
+         (stack-frame (nth (selected-stack-frame-index debugger-pane)
+                           (backtrace (condition-info debugger-pane)))))
+    (execute-frame-command *application-frame* 
+                           `(com-toggle-stack-frame-view ,stack-frame))))
+
+(define-clim-debugger-command
+    (com-browse-next-stack-frame
+     :name "Browse next stack-frame"
+     :keystroke (#\N))
+    ()
+  ;; Minize current stack-frame, select and expand next stack-frame.
+  (let* ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane))
+         (current-stack-frame (nth (selected-stack-frame-index debugger-pane)
+                                   (backtrace (condition-info debugger-pane)))))
+    (setf (view current-stack-frame) +minimized-stack-frame-view+)
+    (com-next-stack-frame)
+    ;; We have a new current stack-frame (this shadowing may be a bit
+    ;; ugly)..
+    (let ((current-stack-frame (nth (selected-stack-frame-index debugger-pane)
+                                    (backtrace (condition-info debugger-pane)))))
+      (setf (view current-stack-frame) +maximized-stack-frame-view+))))
+
+(define-clim-debugger-command
+    (com-browse-prev-stack-frame
+     :name "Browse previous stack-frame"
+     :keystroke (#\P))
+    ()
+  ;; Minize current stack-frame, select and expand previous stack-frame.
+  (let* ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane))
+         (current-stack-frame (nth (selected-stack-frame-index debugger-pane)
+                                   (backtrace (condition-info debugger-pane)))))
+    (setf (view current-stack-frame) +minimized-stack-frame-view+)
+    (com-prev-stack-frame)
+    ;; We have a new current stack-frame.
+    (let ((current-stack-frame (nth (selected-stack-frame-index debugger-pane)
+                                    (backtrace (condition-info debugger-pane)))))
+      (setf (view current-stack-frame) +maximized-stack-frame-view+))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   Command translators   ;;;;;;;;;;;;;;;;;;;;;
@@ -241,7 +494,16 @@
   (list object))
 
 (define-presentation-to-command-translator toggle-stack-frame-view
-    (stack-frame com-toggle-stack-frame-view clim-debugger :gesture :select)
+    (stack-frame com-toggle-stack-frame-view clim-debugger
+                 :gesture :select
+                 :documentation "Toggle stack frame view")
+    (object)
+  (list object))
+
+(define-presentation-to-command-translator eval-in-frame
+    (stack-frame com-eval-in-frame clim-debugger
+                 :gesture :edit
+                 :documentation "Eval in frame")
     (object)
   (list object))
 
@@ -262,15 +524,15 @@
       (formatting-cell (pane) (bold (pane) (format t "~A" first))))
     (formatting-cell (pane)
       (with-text-family (pane family) 
-       (format t "~A" second)))))
+        (format t "~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)))
+                                                           pane)))
       (std-form pane "Description:"    (condition-message (condition-info
-                                                            pane)))
+                                                           pane)))
       (when (condition-extra (condition-info pane))
         (std-form pane "Extra:" (condition-extra (condition-info pane))
                   :family :fix))
@@ -287,9 +549,12 @@
     (formatting-table 
 	(pane)
       (loop for r in (restarts (condition-info pane))
-        do (formatting-row (pane)
+         for rcount from 0
+         do (formatting-row (pane)
               (with-output-as-presentation (pane r 'restart)
                 (formatting-cell (pane)
+                  (format pane "~A." rcount))
+                (formatting-cell (pane)
                   (format pane "~A" (restart-name r)))
               
                 (formatting-cell (pane)
@@ -298,8 +563,9 @@
     (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)))))
+                               :width (bounding-rectangle-width (stream-output-history pane))
+                               :height (bounding-rectangle-height (stream-output-history pane))))
+  (highlight-selected-stack-frame pane))
 
 
 (defun display-backtrace (frame pane)
@@ -311,13 +577,16 @@
   (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))))))
+       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)
+                (setf (gethash stack-frame (presentation-hash-table pane))
+                      (present stack-frame 'stack-frame 
+                               :view (view stack-frame)
+                               :single-box t))))))
     (when (>= (length (backtrace (condition-info pane))) 20)
       (formatting-row (pane)
         (formatting-cell (pane))
@@ -325,53 +594,6 @@
           (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)
-  (declare (ignore acceptably for-context-type))
-  (format t "~A  " (frame-string object)))
-
-(define-presentation-method present (object (type stack-frame) stream
-				     (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:")))
-    (fresh-line)
-    (format t "     ")
-    (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)))))
-    (fresh-line)))
-
-(define-presentation-method present (object (type restart) stream
-				     (view textual-view)
-				     &key acceptably for-context-type)
-  (declare (ignore acceptably for-context-type))
-  (bold (stream) (format t "~A" (restart-name object))))
-
-(define-presentation-method present (object (type more-type) stream
-				     (view textual-view)
-				     &key acceptably for-context-type)
-  (declare (ignore acceptably for-context-type))
-  (bold (stream) (format t "--- MORE ---")))
-
-(define-presentation-method present (object (type inspect) stream
-				     (view textual-view)
-				     &key acceptably for-context-type)
-  (declare (ignore acceptably for-context-type))
-  (format t "~A" object))
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   Starting the debugger   ;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -412,4 +634,3 @@
       (invoke-debugger 
        (make-condition 'simple-error 
                        :format-control "Debugger test")))))
-
