characters.lisp

   1 ;;; copyright (c) 2004 knowledgeTools Int. GmbH
   2 ;;; Author of this version: David Lichteblau <david@knowledgetools.de>
   3 ;;;
   4 ;;; derived from runes.lisp, (c) copyright 1998,1999 by Gilbert Baumann
   5 ;;;
   6 ;;; License: Lisp-LGPL (See file COPYING for details).
   7 ;;;
   8 ;;; This code is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the version 2.1 of the GNU Lesser General Public
  10 ;;; License as published by the Free Software Foundation, as clarified
  11 ;;; by the "Preamble to the Gnu Lesser General Public License" found in
  12 ;;; the file COPYING.
  13 ;;;
  14 ;;; This code is distributed in the hope that it will be useful,
  15 ;;; but without any warranty; without even the implied warranty of
  16 ;;; merchantability or fitness for a particular purpose.  See the GNU
  17 ;;; Lesser General Public License for more details.
  18 ;;;
  19 ;;; Version 2.1 of the GNU Lesser General Public License is in the file
  20 ;;; COPYING that was distributed with this file.  If it is not present,
  21 ;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
  22 ;;; superseded by a newer version) or write to the Free Software
  23 ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  24
  25 (in-package :runes)
  26
  27 (deftype rune () #-lispworks 'character #+lispworks 'lw:simple-char)
  28 (deftype rod () '(vector rune))
  29 (deftype simple-rod () '(simple-array rune))
  30
  31 (definline rune (rod index)
  32   (char rod index))
  33
  34 (defun (setf rune) (new rod index)
  35   (setf (char rod index) new))
  36
  37 (definline %rune (rod index)
  38   (aref (the simple-string rod) (the fixnum index)))
  39
  40 (definline (setf %rune) (new rod index)
  41   (setf (aref (the simple-string rod) (the fixnum index)) new))
  42
  43 (defun rod-capitalize (rod)
  44   (string-upcase rod))
  45
  46 (definline code-rune (x) (code-char x))
  47 (definline rune-code (x) (char-code x))
  48
  49 (definline rune= (x y)
  50   (char= x y))
  51
  52 (defun rune-downcase (rune)
  53   (char-downcase rune))
  54
  55 (definline rune-upcase (rune)
  56   (char-upcase rune))
  57
  58 (defun rune-upper-case-letter-p (rune)
  59   (upper-case-p rune))
  60
  61 (defun rune-lower-case-letter-p (rune)
  62   (lower-case-p rune))
  63
  64 (defun rune-equal (x y)
  65   (char-equal x y))
  66
  67 (defun rod-downcase (rod)
  68   (string-downcase rod))
  69
  70 (defun rod-upcase (rod)
  71   (string-upcase rod))
  72
  73 (definline white-space-rune-p (char)
  74   (or (char= char #\tab)
  75       (char= char #.(code-char 10))     ;Linefeed
  76       (char= char #.(code-char 13))     ;Carriage Return
  77       (char= char #\space)))
  78
  79 (definline digit-rune-p (char &optional (radix 10))
  80   (digit-char-p char radix))
  81
  82 (defun rod (x)
  83   (cond
  84     ((stringp x)    x)
  85     ((symbolp x)    (string x))
  86     ((characterp x) (string x))
  87     ((vectorp x)    (coerce x 'string))
  88     ((integerp x)   (string (code-char x)))
  89     (t              (error "Cannot convert ~S to a ~S" x 'rod))))
  90
  91 (defun runep (x)
  92   (characterp x))
  93
  94 (defun sloopy-rod-p (x)
  95   (stringp x))
  96
  97 (defun rod= (x y)
  98   (if (zerop (length x))
  99       (zerop (length y))
 100       (and (plusp (length y)) (string= x y))))
 101
 102 (defun rod-equal (x y)
 103   (string-equal x y))
 104
 105 (definline make-rod (size)
 106   (make-string size :element-type 'rune))
 107
 108 (defun char-rune (char)
 109   char)
 110
 111 (defun rune-char (rune &optional default)
 112   (declare (ignore default))
 113   rune)
 114
 115 (defun rod-string (rod &optional (default-char #\?))
 116   (declare (ignore default-char))
 117   rod)
 118
 119 (defun string-rod (string)
 120   string)
 121
 122 ;;;;
 123
 124 (defun rune<= (rune &rest more-runes)
 125   (loop
 126       for (a b) on (cons rune more-runes)
 127       while b
 128       always (char<= a b)))
 129
 130 (defun rune>= (rune &rest more-runes)
 131   (loop
 132       for (a b) on (cons rune more-runes)
 133       while b
 134       always (char>= a b)))
 135
 136 (defun rodp (object)
 137   (stringp object))
 138
 139 (defun rod-subseq (source start &optional (end (length source)))
 140   (unless (stringp source)
 141     (error "~S is not of type ~S." source 'rod))
 142   (subseq source start end))
 143
 144 (defun rod-subseq* (source start &optional (end (length source)))
 145   (rod-subseq source start end))
 146
 147 (defun rod< (rod1 rod2)
 148   (string< rod1 rod2))