X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-char.lisp;h=18ea349e0cec8507567c4e469ebfe95111361aac;hb=290675ccc55b43bef1c2c39f07479dbb2f20ad1f;hp=92d529bcdf6f1c713d34c2cdac207dc6d6f71083;hpb=acc978383105b5a2bfd970f8a34214fd5774bb2a;p=sbcl.git diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp index 92d529b..18ea349 100644 --- a/src/code/target-char.lisp +++ b/src/code/target-char.lisp @@ -67,8 +67,10 @@ for char-name = (string-upcase (read stream nil nil)) while code-point do (setf (gethash code-point names) char-name)) - (let ((tree (make-huffman-tree - (let (list) + (let ((tree + #!+sb-unicode + (make-huffman-tree + (let (list) (maphash (lambda (code name) (declare (ignore code)) (push name list)) @@ -248,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 @@ -267,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