X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftarget-char.lisp;h=18ea349e0cec8507567c4e469ebfe95111361aac;hb=290675ccc55b43bef1c2c39f07479dbb2f20ad1f;hp=3b7eea72585781ee179e08b3ebb1849a1b40cdfb;hpb=c9aeeb418b6ac881bb76f480cace06fb4687d769;p=sbcl.git

diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp
index 3b7eea7..18ea349 100644
--- a/src/code/target-char.lisp
+++ b/src/code/target-char.lisp
@@ -68,9 +68,9 @@
                           while code-point
                           do (setf (gethash code-point names) char-name))
                        (let ((tree
-			      #!+sb-unicode
-			       (make-huffman-tree
-				(let (list)
+                              #!+sb-unicode
+                               (make-huffman-tree
+                                (let (list)
                                       (maphash (lambda (code name)
                                                  (declare (ignore code))
                                                  (push name list))
@@ -250,8 +250,13 @@
         (let ((h-code (cdr (binary-search char-code
                                           (car *unicode-character-name-database*)
                                           :key #'car))))
-          (when h-code
-            (huffman-decode h-code *unicode-character-name-huffman-tree*))))))
+          (cond
+            (h-code
+             (huffman-decode h-code *unicode-character-name-huffman-tree*))
+            ((< char-code #x10000)
+             (format nil "U~4,'0X" char-code))
+            (t
+             (format nil "U~8,'0X" char-code)))))))
 
 (defun name-char (name)
   #!+sb-doc
@@ -269,9 +274,19 @@
           (let ((char-code
                  (car (binary-search encoding
                                      (cdr *unicode-character-name-database*)
-                                     :key #'cdr))))
-            (when char-code
-              (code-char char-code)))))))
+                                     :key #'cdr)))
+                (name-length (length name)))
+            (cond
+              (char-code
+               (code-char char-code))
+              ((and (or (= name-length 9)
+                        (= name-length 5))
+                    (char-equal (char name 0) #\U)
+                    (loop for i from 1 below name-length
+                          always (digit-char-p (char name i) 16)))
+               (code-char (parse-integer name :start 1 :radix 16)))
+              (t
+               nil)))))))
 
 ;;;; predicates