Initial revision

glisp/characters.lisp

@@ -0,0 +1,132 @@
+;;; copyright (c) 2004 knowledgeTools Int. GmbH
+;;; Author of this version: David Lichteblau <david@knowledgetools.de>
+;;;
+;;; License: LGPL (See file COPYING for details).
+;;;
+;;; derived from runes.lisp, (c) copyright 1998,1999 by Gilbert Baumann
+
+(in-package :glisp)
+
+(deftype rune () 'base-char)
+(deftype rod () 'base-string)
+(deftype simple-rod () 'simple-string)
+
+(defsubst rune (rod index)
+  (char rod index))
+
+(defun (setf rune) (new rod index)
+  (setf (char rod index) new))
+
+(defsubst %rune (rod index)
+  (aref (the simple-string rod) (the fixnum index)))
+
+(defsubst (setf %rune) (new rod index)
+  (setf (aref (the simple-string rod) (the fixnum index)) new))
+
+(defun rod-capitalize (rod)
+  (string-upcase rod))
+
+(defsubst code-rune (x) (code-char x))
+(defsubst rune-code (x) (char-code x))
+
+(defsubst rune= (x y) 
+  (char= x y))
+
+(defun rune-downcase (rune)
+  (char-downcase rune))
+
+(defsubst rune-upcase (rune)
+  (char-upcase rune))
+
+(defun rune-upper-case-letter-p (rune)
+  (upper-case-p rune))
+
+(defun rune-lower-case-letter-p (rune)
+  (lower-case-p rune))
+
+(defun rune-equal (x y)
+  (char-equal x y))
+
+(defun rod-downcase (rod)
+  (string-downcase rod))
+
+(defun rod-upcase (rod)
+  (string-upcase rod))
+
+(defsubst white-space-rune-p (char)
+  (or (char= char #\tab)
+      (char= char #.(code-char 10))     ;Linefeed
+      (char= char #.(code-char 13))     ;Carriage Return
+      (char= char #\space)))
+
+(defsubst digit-rune-p (char &optional (radix 10))
+  (digit-char-p char radix))
+
+(defun rod (x)
+  (cond
+    ((stringp x)    x)
+    ((symbolp x)    (string x))
+    ((characterp x) (string x))
+    ((vectorp x)    (coerce x 'string))
+    ((integerp x)   (string (code-char x)))
+    (t              (error "Cannot convert ~S to a ~S" x 'rod))))
+
+(defun runep (x)
+  (characterp x))
+
+(defun sloopy-rod-p (x)
+  (stringp x))
+
+(defun rod= (x y)
+  (string= x y))
+
+(defun rod-equal (x y)
+  (string-equal x y))
+
+(defsubst make-rod (size)
+  (make-string size))
+
+(defun char-rune (char)
+  char)
+
+(defun rune-char (rune &optional default)
+  (declare (ignore default))
+  rune)
+
+(defun rod-string (rod &optional (default-char #\?))
+  (declare (ignore default-char))
+  rod)
+
+(defun string-rod (string)
+  string)
+
+;;;;
+
+(defun rune<= (rune &rest more-runes)
+  (loop
+      for (a b) on (cons rune more-runes)
+      while b
+      always (char<= a b)))
+
+(defun rune>= (rune &rest more-runes)
+  (loop
+      for (a b) on (cons rune more-runes)
+      while b
+      always (char>= a b)))
+
+(defun rodp (object)
+  (stringp object))
+
+(defun really-rod-p (object)
+  (stringp object))
+
+(defun rod-subseq (source start &optional (end (length source)))
+  (unless (stringp source)
+    (error "~S is not of type ~S." source 'rod))
+  (subseq source start end))
+
+(defun rod-subseq* (source start &optional (end (length source)))
+  (rod-subseq source start end))
+
+(defun rod< (rod1 rod2)
+  (string< rod1 rod2))