Fix PRINT-OBJECT (EXCEPTION T).

darcs-hash:28e399d1243d9825ae590aba3fd55dc1a4d9706c

1 files changed, 10 insertions, 1 deletions

diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp
index 384c7e2..175e3df 100644
--- a/Lisp/utilities.lisp
+++ b/Lisp/utilities.lisp
@@ -275,7 +275,9 @@ invocations will return numbers.)
 
 (defmethod print-object ((exception exception) stream)
   (print-unreadable-object (exception stream)
-    (with-slots (pointer) exception
+    ;; FIXME: Inexplicably, WITH-SLOTS doesn't work for exceptions.  Is
+    ;; direct slot access disallowed for instances of type CONDITION?
+    (with-accessors ((pointer pointer-to)) exception
       (format stream "~S ~A {~X}"
               (type-of exception)
               (primitive-invoke (primitive-invoke exception "name" 'id)
@@ -283,6 +285,13 @@ invocations will return numbers.)
               (cffi:pointer-address pointer)))))
 
 
+(defmethod describe-object :after ((exception exception) stream)
+  (format stream "Objective-C runtime type: ~S~&~
+                  Reason: ~S"
+          (invoke-by-name (invoke-by-name exception "name") "UTF8String")
+          (invoke-by-name (invoke-by-name exception "reason") "UTF8String")))
+
+
 (defmethod print-object ((struct foreign-struct) stream)
   (print-unreadable-object (struct stream)
     (with-slots (pointer name) struct