From b63a23eb1af229f30e2e73810123347fbf9fac46 Mon Sep 17 00:00:00 2001
From: JeffBezanson <jeff.bezanson@gmail.com>
Date: Tue, 24 Mar 2009 21:27:38 +0000
Subject: [PATCH] char read/print improvement adding char.upcase and
 char.downcase

---
 femtolisp/print.c  |  5 +----
 femtolisp/read.c   |  5 +++--
 femtolisp/string.c | 21 +++++++++++++++++++++
 3 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/femtolisp/print.c b/femtolisp/print.c
index c84fdb7..3425958 100644
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -475,11 +475,8 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
             if (!princ) outsn("#\\", f, 2);
             outs(seq, f);
         }
-        else if (weak) {
-            HPOS+=ios_printf(f, "%d", (int)wc);
-        }
         else {
-            HPOS+=ios_printf(f, "#%s(%d)", symbol_name(type), (int)wc);
+            HPOS+=ios_printf(f, "#\\x%04x", (int)wc);
         }
     }
     else if (type == int64sym
diff --git a/femtolisp/read.c b/femtolisp/read.c
index cfeed3c..eb99f4e 100644
--- a/femtolisp/read.c
+++ b/femtolisp/read.c
@@ -206,9 +206,10 @@ static u_int32_t peek()
             uint32_t cval;
             if (ios_getutf8(F, &cval) == IOS_EOF)
                 lerror(ParseError, "read: end of input in character constant");
-            if (cval == (uint32_t)'u' || cval == (uint32_t)'U') {
+            if (cval == (uint32_t)'u' || cval == (uint32_t)'U' ||
+                cval == (uint32_t)'x') {
                 read_token('u', 0);
-                if (buf[1] != '\0') {  // not a solitary 'u' or 'U'
+                if (buf[1] != '\0') {  // not a solitary 'u','U','x'
                     if (!read_numtok(&buf[1], &tokval, 16))
                         lerror(ParseError,
                                "read: invalid hex character constant");
diff --git a/femtolisp/string.c b/femtolisp/string.c
index 2269c0f..1edbbe6 100644
--- a/femtolisp/string.c
+++ b/femtolisp/string.c
@@ -8,6 +8,7 @@
 #include <stdarg.h>
 #include <assert.h>
 #include <ctype.h>
+#include <wctype.h>
 #include <sys/types.h>
 #include <sys/time.h>
 #include <errno.h>
@@ -193,6 +194,23 @@ value_t fl_string_char(value_t *args, u_int32_t nargs)
     return mk_wchar(u8_nextchar(s, &i));
 }
 
+value_t fl_char_upcase(value_t *args, u_int32_t nargs)
+{
+    argcount("char.upcase", nargs, 1);
+    cprim_t *cp = (cprim_t*)ptr(args[0]);
+    if (!iscprim(args[0]) || cp_class(cp) != wchartype)
+      type_error("char.upcase", "wchar", args[0]);
+    return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
+}
+value_t fl_char_downcase(value_t *args, u_int32_t nargs)
+{
+    argcount("char.downcase", nargs, 1);
+    cprim_t *cp = (cprim_t*)ptr(args[0]);
+    if (!iscprim(args[0]) || cp_class(cp) != wchartype)
+      type_error("char.downcase", "wchar", args[0]);
+    return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
+}
+
 static value_t mem_find_byte(char *s, char c, size_t start, size_t len)
 {
     char *p = memchr(s+start, c, len-start);
@@ -351,6 +369,9 @@ static builtinspec_t stringfunc_info[] = {
     { "string.encode", fl_string_encode },
     { "string.decode", fl_string_decode },
 
+    { "char.upcase", fl_char_upcase },
+    { "char.downcase", fl_char_downcase },
+
     { "number->string", fl_numbertostring },
     { "string->number", fl_stringtonumber },