From e58c53cca5b6121cda1384ae290a74748e959954 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Sun, 10 Aug 2008 11:50:39 -0700
Subject: [PATCH] symbols containing unicode characters now print properly and
 respect the print-unicode parameter.

---
 scheme/ikarus.writer.ss | 14 +++++++++++---
 scheme/last-revision    |  2 +-
 2 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/scheme/ikarus.writer.ss b/scheme/ikarus.writer.ss
index 4f90917..0254aea 100644
--- a/scheme/ikarus.writer.ss
+++ b/scheme/ikarus.writer.ss
@@ -28,7 +28,6 @@
     (ikarus system $bytevectors)
     (ikarus system $transcoders)
     (only (ikarus.pretty-formats) get-fmt)
-    ;(only (ikarus unicode-data) unicode-printable-char?) 
     (except (ikarus) 
       write display format printf fprintf print-error print-unicode print-graph
       put-datum))
@@ -285,6 +284,10 @@
                   ($fxlogand mask
                     ($bytevector-u8-ref map j))))))))
 
+  (define initial-categories 
+    '(Lu Ll Lt Lm Lo Mn Nl No Pd Pc Po Sc Sm Sk So Co))
+  (define subsequent-categories
+    '(Nd Mc Me))
 
   (define (write-subsequent* str i j p)
     (unless ($fx= i j) 
@@ -295,7 +298,10 @@
            (write-char c p)]
           [($fx< b 128) 
            (write-inline-hex b p)]
-          [(unicode-printable-char? c)
+          [(and (print-unicode) 
+             (let ([cat (char-general-category c)])
+               (or (memq cat initial-categories)
+                   (memq cat subsequent-categories))))
            (write-char c p)]
           [else 
            (write-inline-hex b p)]))
@@ -315,7 +321,9 @@
                [(in-map? b0 initials-map) 
                 (write-char c0 p)]
                [($fx< b0 128) (write-inline-hex b0 p)]
-               [(unicode-printable-char? c0) (write-char c0 p)]
+               [(and (print-unicode) 
+                  (memq (char-general-category c0) initial-categories))
+                (write-char c0 p)]
                [else (write-inline-hex b0 p)])
              (write-subsequent* str 1 n p))]))))
 
diff --git a/scheme/last-revision b/scheme/last-revision
index f137a56..2907ff5 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1582
+1583