* Added print-condition procedure which now prints an ugly message.

scheme/ikarus.cafe.ss

@@ -26,7 +26,6 @@ description:
   (export new-cafe)
   (import 
     (only (rnrs) with-exception-handler)
-    (only (ikarus exceptions) print-condition)
     (only (psyntax expander) eval-top-level)
     (except (ikarus) new-cafe))
 

scheme/ikarus.conditions.ss

@@ -1,7 +1,7 @@
 
 (library (ikarus conditions)
   (export condition? simple-conditions condition-predicate
-          condition condition-accessor
+          condition condition-accessor print-condition
 
           ;;; too much junk
           make-message-condition message-condition?
@@ -62,6 +62,7 @@
     (only (ikarus records procedural) rtd? rtd-subtype?)
     (except (ikarus) define-condition-type condition? simple-conditions
           condition condition-predicate condition-accessor
+          print-condition
           
           ;;; more junk
           make-message-condition message-condition?
@@ -300,5 +301,19 @@
   (define-condition-type &no-nans &implementation-restriction
     make-no-nans-violation no-nans-violation?)
 
+  (define print-condition 
+    (let ()
+      (define (print-condition x p)
+        (display "CONDITION: " p)
+        (write x p)
+        (newline p))
+      (case-lambda
+        [(x) 
+         (print-condition x (console-output-port))]
+        [(x port)
+         (if (output-port? port) 
+             (print-condition x port)
+             (error 'print-condition "~s is not an output port" port))])))
+
   )
 

scheme/ikarus.exceptions.ss

@@ -1,7 +1,6 @@
 
 (library (ikarus exceptions)
-  (export with-exception-handler raise raise-continuable error
-          print-condition)
+  (export with-exception-handler raise raise-continuable error)
   (import 
     (only (rnrs) condition make-non-continuable-violation
           make-message-condition make-error make-who-condition
@@ -9,8 +8,6 @@
     (except (ikarus)
       with-exception-handler raise raise-continuable error))
 
-  (define (print-condition x)
-    (printf "CONDITION: ~s\n" x))
 
   (define handlers
     (make-parameter
@@ -50,15 +47,12 @@
     (unless (string? msg) 
       (error 'error "message ~s is not a string" msg))
     (raise
-      (if who
-          (condition
-            (make-error)
-            (make-who-condition who) 
-            (make-message-condition msg) 
-            (make-irritants-condition irritants))
        (condition
          (make-error)
+         (if who (make-who-condition who) (condition))
          (make-message-condition msg)
+         (if (null? irritants) 
+             (condition)
              (make-irritants-condition irritants)))))
 
 

scheme/makefile.ss

@@ -893,6 +893,7 @@
     [utf8->string                                i r bv]
     [utf16->string                               r bv]
     [utf32->string                               r bv]
+    [print-condition                             i]
     [condition?                                  r co]
     [&assertion                                  r co]
     [assertion-violation?                        r co]