From: Ken Harris <kengruven@gmail.com>
Date: Sun, 2 Jun 2013 17:31:06 +0000 (-0700)
Subject: Extend DIGIT-CHAR-P to include all HexDigit characters.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=af6a9d1af26a42badfe04d0a8d3a8cf7cfbef576;p=jscl.git

Extend DIGIT-CHAR-P to include all HexDigit characters.
---

diff --git a/src/char.lisp b/src/char.lisp
index 2a36d91..645597c 100644
--- a/src/char.lisp
+++ b/src/char.lisp
@@ -254,21 +254,26 @@ character exists."
        (>= weight 0) (< weight radix) (< weight 36)
        (code-char (if (< weight 10) (+ 48 weight) (+ 55 weight)))))
 
-;; borrowed from my proposed fix to SBCL: https://bugs.launchpad.net/sbcl/+bug/1177986
+;; From comment #4 on <https://bugs.launchpad.net/sbcl/+bug/1177986>:
 (defun digit-char-p (char &optional (radix 10))
-  (let ((number (unicode-digit-value char))
-        (code (char-code char))
-        (little-a (char-code #\a))
-        (big-a (char-code #\A)))
-    (cond ((and number (< number radix))
-           number)
-          (number
-           nil)
-          ((<= big-a code (+ big-a radix -10 -1))
-           (+ code (- big-a) 10))
-          ((<= little-a code (+ little-a radix -10 -1))
-           (+ code (- little-a) 10))
-          (t nil))))
+  "Includes ASCII 0-9 a-z A-Z, plus Unicode HexDigit characters (fullwidth variants of 0-9 and A-F)."
+  (let* ((number (unicode-digit-value char))
+	 (code (char-code char))
+	 (upper (char-upcase char))
+	 (code-upper (char-code upper))
+	 (potential (cond (number number)
+			  ((char<= #\0 char #\9)
+			   (- code (char-code #\0)))
+			  ((<= 65296 code 65305)  ;; FULLWIDTH_DIGIT_ZERO, FULLWIDTH_DIGIT_NINE
+			   (- code 65296))
+			  ((char<= #\A upper #\Z)
+			   (+ 10 (- code-upper (char-code #\A))))
+			  ((<= 65313 (char-code upper) 65318)  ;; FULLWIDTH_LATIN_CAPITAL_LETTER_A, FULLWIDTH_LATIN_CAPITAL_LETTER_F
+			   (+ 10 (- code-upper 65313)))
+			  (t nil))))
+    (if (and potential (< potential radix))
+	potential
+      nil)))
 
 (defun graphic-char-p (char)
   ;; from SBCL/CMUCL:
diff --git a/tests/characters.lisp b/tests/characters.lisp
index aa8388e..a745051 100644
--- a/tests/characters.lisp
+++ b/tests/characters.lisp
@@ -88,7 +88,10 @@
 (test (null (digit-char-p #\a)))
 (test (= 10 (digit-char-p #\A 11)))
 (test (= 10 (digit-char-p #\a 11)))
-;; TODO: does the mapcar/lambda thing work here?
+;; (mapcar #'(lambda (radix)
+;;              (map 'list #'(lambda (x) (digit-char-p x radix))
+;;                   "059AaFGZ"))
+;;          '(2 8 10 16 36))
 
 ;; GRAPHIC-CHAR-P
 (test (graphic-char-p #\G))