From: Ken Harris <kengruven@gmail.com>
Date: Thu, 9 May 2013 06:35:59 +0000 (-0700)
Subject: Character comparisons, case insensitive.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f8e5f4e8ae9b7bdc7efc7382a26aa6e28f6c4652;p=jscl.git

Character comparisons, case insensitive.
---

diff --git a/src/char.lisp b/src/char.lisp
index ede7352..6fe28b6 100644
--- a/src/char.lisp
+++ b/src/char.lisp
@@ -43,6 +43,68 @@
 		   (char-int (car list)))
 	 (return nil))))
 
+(defun equal-char-code (character)
+  (char-code (char-upcase character)))
+
+(defun two-arg-char-equal (c1 c2)
+  (= (equal-char-code c1) (equal-char-code c2)))
+
+(defun char-equal (character &rest more-characters)
+  (do ((clist more-characters (cdr clist)))
+      ((null clist) t)
+      (unless (two-arg-char-equal (car clist) character)
+	(return nil))))
+
+(defun char-not-equal (character &rest more-characters)
+  (do* ((head character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (do* ((l list (cdr l)))
+  		    ((null l) t)
+  		    (when (two-arg-char-equal head (car l))
+  			(return nil)))
+  	 (return nil))))
+
+(defun two-arg-char-lessp (c1 c2)
+  (< (equal-char-code c1) (equal-char-code c2)))
+
+(defun char-lessp (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (two-arg-char-lessp c (car list))
+	 (return nil))))
+
+(defun two-arg-char-greaterp (c1 c2)
+  (> (equal-char-code c1) (equal-char-code c2)))
+
+(defun char-greaterp (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (two-arg-char-greaterp c (car list))
+	 (return nil))))
+
+(defun two-arg-char-not-greaterp (c1 c2)
+  (<= (equal-char-code c1) (equal-char-code c2)))
+
+(defun char-not-greaterp (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (two-arg-char-not-greaterp c (car list))
+	 (return nil))))
+
+(defun two-arg-char-not-lessp (c1 c2)
+  (>= (equal-char-code c1) (equal-char-code c2)))
+
+(defun char-not-lessp (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (two-arg-char-not-lessp c (car list))
+	 (return nil))))
+
 (defun character (character)
   (cond ((characterp character)
 	 character)
diff --git a/tests/characters.lisp b/tests/characters.lisp
index 9ec833d..dc0cf68 100644
--- a/tests/characters.lisp
+++ b/tests/characters.lisp
@@ -33,7 +33,7 @@
 (test (not (char>= #\e #\d #\b #\c #\a)))
 ;; (char> #\z #\A) =>  implementation-dependent
 ;; (char> #\Z #\a) =>  implementation-dependent
-;; (test (char-equal #\A #\a))
+(test (char-equal #\A #\a))
 ;; (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char-lessp) =>  (#\A #\a #\b #\B #\c #\C)
 ;; (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char<) => implementation-dependent