[armedbear-cvs] r11390 - trunk/j/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Nov 15 22:12:31 2008
New Revision: 11390

Log:
Make JAVA-EXCEPTION objects print more human readable.

Inspired by: Mark Evenson


Modified:
   trunk/j/src/org/armedbear/lisp/print-object.lisp

Modified: trunk/j/src/org/armedbear/lisp/print-object.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/print-object.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/print-object.lisp	Sat Nov 15 22:12:31 2008
@@ -20,6 +20,7 @@
 (in-package #:system)
 
 (require 'clos)
+(require 'java)
 
 (when (autoloadp 'print-object)
   (fmakunbound 'print-object))
@@ -104,4 +105,14 @@
                 (cell-error-name x)))
       (format stream "The variable ~S is unbound." (cell-error-name x))))
 
+(defmethod print-object ((e java:java-exception) stream)
+  (if *print-escape*
+      (print-unreadable-object (e stream :type t :identity t)
+        (format stream "~A"
+                (java:jcall (java:jmethod "java.lang.Object" "toString")
+                            (java:java-exception-cause e))))
+      (format stream "Java exception '~A'."
+              (java:jcall (java:jmethod "java.lang.Object" "toString")
+                          (java:java-exception-cause e)))))
+
 (provide 'print-object)