[Openmcl-cvs-notifications] r12662 - /trunk/source/cocoa-ide/cocoa-backtrace.lisp

[gz at clozure.com]

Author: gz
Date: Mon Aug 24 12:18:49 2009
New Revision: 12662

Log:
Make the backtrace handle non-lfun frames better

Modified:
    trunk/source/cocoa-ide/cocoa-backtrace.lisp

Modified: trunk/source/cocoa-ide/cocoa-backtrace.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-backtrace.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-backtrace.lisp Mon Aug 24 12:18:49 2009
@@ -91,22 +91,27 @@
          (lfun (ccl:frame-function fp context)))
     (make-instance 'frame-descriptor
       :data (cons fp context)
-      :label (with-output-to-string (stream)
-               (format stream "(~S" (or (ccl:function-name lfun) lfun))
-               (if (eq args (ccl::%unbound-marker))
-                 (format stream " #<Unknown Arguments>")
-                 (loop for arg in args
-                   do (if (eq arg (ccl::%unbound-marker))
-                        (format stream " #<Unavailable>")
-                        (format stream " ~:['~;~]~s" (ccl::self-evaluating=
-p arg) arg))))
-               (format stream ")"))
-      :values (map 'vector
-                   (lambda (var.val)
-                     (destructuring-bind (var . val) var.val
-                       (let ((label (format nil "~:[~s~;~a~]: ~s"
-                                            (stringp var) var val)))
-                         (cons label var.val))))
-                   (cons `("Function" . ,lfun) vars)))))
+      :label (if lfun
+               (with-output-to-string (stream)
+                 (format stream "(~S" (or (ccl:function-name lfun) lfun))
+                 (if (eq args (ccl::%unbound-marker))
+                   (format stream " #<Unknown Arguments>")
+                   (loop for arg in args
+                     do (if (eq arg (ccl::%unbound-marker))
+                          (format stream " #<Unavailable>")
+                          (format stream " ~:['~;~]~s" (ccl::self-evaluati=
ng-p arg) arg))))
+                 (format stream ")"))
+               ":kernel")
+      :values (if lfun
+                (map 'vector
+                     (lambda (var.val)
+                       (destructuring-bind (var . val) var.val
+                         (let ((label (format nil "~:[~s~;~a~]: ~s"
+                                              (stringp var) var val)))
+                           (cons label var.val))))
+                     (cons `("Function" . ,lfun)
+                           (and (not (eq vars (ccl::%unbound-marker))) var=
s)))
+                ))))
 =

 (defmethod stack-descriptor-frame ((sd stack-descriptor) index)
   (let ((cache (stack-descriptor-frame-cache sd)))
@@ -307,9 +312,10 @@
 =

 (objc:defmethod (#/outlineView:isItemExpandable: :<BOOL>)
     ((self backtrace-window-controller) view item)
-    (declare (ignore view))
-    (or (%null-ptr-p item)
-        (our-frame-label-p self item)))
+  (declare (ignore view))
+  (or (%null-ptr-p item)
+      (and (our-frame-label-p self item)
+           (> (frame-descriptor-value-count (frame-label-descriptor item))=
 0))))
 =

 (objc:defmethod (#/outlineView:numberOfChildrenOfItem: :<NSI>nteger)
     ((self backtrace-window-controller) view item)