[mcclim-devel] clim-debugger

[Andreas Fuchs]

Today, Peter Mechlenborg <metch at daimi.au.dk> wrote:
> Changes:
>
> - A "more button" have been added, so more stack-frames can be
>   viewed if 20 isn't enough.
>
> - Scroll-bars have been added, thanks to Elliott Johnson. There's
>   still a small problem though. The scroll-bars do not remember their
>   position when a stack-frame or "more" is pressed. I don't know how
>   to fix this, couldn't find anything in the specs and Clouseau didn't
>   help either. Do anyone of you know how to do this?
>
> - Frame variables are viewed with Clouseau when pressed.
>
>
> What do you think?

I think it rocks. I found the fonts a bit unreadable on descriptive
texts, so I hacked on it a little. This patch adds:

 * better fonts on descriptions (not on reference-conditions reference
   slots yet, I'm hoping somebody figures a way to render them soon)
 * (maybe) better formatting of reference condition descriptions &
   extra condition info
 * better handling of multi-table-column presentation (you can now
   click on a stack frame number and on a restart description)
 * doesn't show the --MORE-- link when there are fewer than 20 frames.

Here's some lisp porn:
http://boinkor.net/lisp/porn/clim-debugger_pretty.png (-:
 
Hope you like it.
--- clim-debugger.orig.lisp     2005-04-14 19:08:32.000000000 +0200
+++ clim-debugger.lisp  2005-04-15 00:18:25.861376109 +0200
@@ -255,13 +255,14 @@
 ;;;   Display debugging info   ;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun std-form (pane first second)
+(defun std-form (pane first second &key (family :sans-serif))
   (formatting-row 
       (pane)
-    (formatting-cell (pane) (bold (pane) (format t "~A" first)))
-    (formatting-cell 
-       (pane) 
-      (format t "~A" second))))
+    (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)))))
 
 (defun display-debugger (frame pane)
   (let ((*standard-output* pane))
@@ -269,26 +270,32 @@
       (std-form pane "Condition type:" (type-of-condition (condition-info
                                                             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))
+      (when (condition-references (condition-info pane))
+        (std-form pane "References:" (condition-references (condition-info
+                                                            pane))
+                  :family :fix)))
     (fresh-line)
-    (when (condition-extra (condition-info pane))
-      (formatting-table (pane)
-       (std-form pane "Extra:" (condition-extra (condition-info pane))))
-      (fresh-line))
-    (when (condition-references (condition-info pane))
-      (formatting-table (pane)
-       (std-form pane "References:" (condition-references (condition-info
-                                                             pane))))
-      (fresh-line))
-    (bold (pane) (format t "Restarts:"))
+    
+    
+    (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) 
-             (formatting-cell (pane) (present r 'restart))
-             (formatting-cell (pane) (format t "~A" r)))))
+        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
@@ -298,7 +305,8 @@
 
 (defun display-backtrace (frame pane)
   (declare (ignore frame)) 
-  (bold (pane) (format t "Backtrace:"))
+  (with-text-family (pane :sans-serif)
+    (bold (pane) (format t "Backtrace:")))
   (fresh-line)
   (format t " ")
   (formatting-table 
@@ -306,14 +314,17 @@
     (loop for stack-frame in (backtrace (condition-info pane))
          for i from 0
          do (formatting-row (pane)
-              (bold (pane) (formatting-cell (pane) (format t "~A: " i)))
-              (formatting-cell (pane) (present stack-frame 'stack-frame 
-                                               :view (view stack-frame)))))
-  (formatting-row (pane)
-    (formatting-cell (pane))
-    (formatting-cell (pane)
-      (bold (pane)
-       (present pane 'more-type))))))
+               (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)))))))
 
 
 (define-presentation-method present (object (type stack-frame) stream
@@ -329,7 +340,8 @@
   (progn
     (princ (frame-string object) stream)
     (fresh-line)
-    (bold (stream) (format t "  Locals:"))
+    (with-text-family (stream :sans-serif)
+      (bold (stream) (format t "  Locals:")))
     (fresh-line)
     (format t "     ")
     (formatting-table 


Cheers,
-- 
Andreas Fuchs, <asf at boinkor.net>, asf at jabber.at, antifuchs