147 lines
3.8 KiB
Common Lisp
147 lines
3.8 KiB
Common Lisp
;;; copyright (c) 2004 knowledgeTools Int. GmbH
|
|
;;; Author of this version: David Lichteblau <david@knowledgetools.de>
|
|
;;;
|
|
;;; derived from runes.lisp, (c) copyright 1998,1999 by Gilbert Baumann
|
|
;;;
|
|
;;; License: Lisp-LGPL (See file COPYING for details).
|
|
;;;
|
|
;;; This code is free software; you can redistribute it and/or modify it
|
|
;;; under the terms of the version 2.1 of the GNU Lesser General Public
|
|
;;; License as published by the Free Software Foundation, as clarified
|
|
;;; by the "Preamble to the Gnu Lesser General Public License" found in
|
|
;;; the file COPYING.
|
|
;;;
|
|
;;; This code is distributed in the hope that it will be useful,
|
|
;;; but without any warranty; without even the implied warranty of
|
|
;;; merchantability or fitness for a particular purpose. See the GNU
|
|
;;; Lesser General Public License for more details.
|
|
;;;
|
|
;;; Version 2.1 of the GNU Lesser General Public License is in the file
|
|
;;; COPYING that was distributed with this file. If it is not present,
|
|
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
|
|
;;; superseded by a newer version) or write to the Free Software
|
|
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
(in-package :runes)
|
|
|
|
(deftype rune () #-lispworks 'character #+lispworks 'lw:simple-char)
|
|
(deftype rod () '(vector rune))
|
|
(deftype simple-rod () '(simple-array rune))
|
|
|
|
(definline rune (rod index)
|
|
(char rod index))
|
|
|
|
(defun (setf rune) (new rod index)
|
|
(setf (char rod index) new))
|
|
|
|
(definline %rune (rod index)
|
|
(aref (the simple-string rod) (the fixnum index)))
|
|
|
|
(definline (setf %rune) (new rod index)
|
|
(setf (aref (the simple-string rod) (the fixnum index)) new))
|
|
|
|
(defun rod-capitalize (rod)
|
|
(string-upcase rod))
|
|
|
|
(definline code-rune (x) (code-char x))
|
|
(definline rune-code (x) (char-code x))
|
|
|
|
(definline rune= (x y)
|
|
(char= x y))
|
|
|
|
(defun rune-downcase (rune)
|
|
(char-downcase rune))
|
|
|
|
(definline 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))
|
|
|
|
(definline 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)))
|
|
|
|
(definline 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))
|
|
|
|
(definline make-rod (size)
|
|
(make-string size :element-type 'rune))
|
|
|
|
(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 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))
|