Import dev version of CL-UNICODE

git-svn-id: svn://bknr.net/svn/trunk/thirdparty/cl-unicode@3579 4281704c-cde7-0310-8518-8e2dc76b1ff0

CHANGELOG.txt

@@ -0,0 +1,3 @@
+Version 0.1.0
+2008-07-23
+Initial release

alias.lisp

@@ -0,0 +1,135 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/alias.lisp,v 1.8 2008/07/21 20:04:13 edi Exp $
+
+;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-unicode)
+
+(defvar *alias-map*
+  '(("L" . "Letter")
+    ("LC" . "CasedLetter")
+    ("Lu" . "UppercaseLetter")
+    ("Ll" . "LowercaseLetter")
+    ("Lt" . "TitlecaseLetter")
+    ("Lm" . "ModifierLetter")
+    ("Lo" . "OtherLetter")
+    ("M" . "Mark")
+    ("Mn" . "NonspacingMark")
+    ("Mc" . "SpacingMark")
+    ("Me" . "EnclosingMark")
+    ("N" . "Number")
+    ("Nd" . "DecimalNumber")
+    ("Nl" . "LetterNumber")
+    ("No" . "OtherNumber")
+    ("P" . "Punctuation")
+    ("Pc" . "ConnectorPunctuation")
+    ("Pd" . "DashPunctuation")
+    ("Ps" . "OpenPunctuation")
+    ("Pe" . "ClosePunctuation")
+    ("Pi" . "InitialPunctuation")
+    ("Pf" . "FinalPunctuation")
+    ("Po" . "OtherPunctuation")
+    ("S" . "Symbol")
+    ("Sm" . "MathSymbol")
+    ("Sc" . "CurrencySymbol")
+    ("Sk" . "ModifierSymbol")
+    ("So" . "OtherSymbol")
+    ("Z" . "Separator")
+    ("Zs" . "SpaceSeparator")
+    ("Zl" . "LineSeparator")
+    ("Zp" . "ParagraphSeparator")
+    ("C" . "Other")
+    ("Cc" . "Control")
+    ("Cf" . "Format")
+    ("Cs" . "Surrogate")
+    ("Co" . "PrivateUse")
+    ("Cn" . "Unassigned")
+    ("Cn" . "NoncharacterCodePoint")))
+
+(defvar *bidi-alias-map*
+  '(("L" . "LeftToRight")
+    ("LRE" . "LeftToRightEmbedding")
+    ("LRO" . "LeftToRightOverride")
+    ("R" . "RightToLeft")
+    ("AL" . "RightToLeftArabic")
+    ("RLE" . "RightToLeftEmbedding")
+    ("RLO" . "RightToLeftOverride")
+    ("PDF" . "PopDirectionalFormat")
+    ("EN" . "EuropeanNumber")
+    ("ES" . "EuropeanNumberSeparator")
+    ("ET" . "EuropeanNumberTerminator")
+    ("AN" . "ArabicNumber")
+    ("CS" . "CommonNumberSeparator")
+    ("NSM" . "NonSpacingMark")
+    ("BN" . "BoundaryNeutral")
+    ("B" . "ParagraphSeparator")
+    ("S" . "SegmentSeparator")
+    ("WS" . "Whitespace")
+    ("ON" . "OtherNeutral")))
+
+(defun create-alias (new-name old-name &optional only-if-unambiguous)
+  (setq new-name (canonicalize-name new-name)
+        old-name (canonicalize-name old-name))
+  (unless only-if-unambiguous
+    (assert (null (gethash new-name *property-map*)) (new-name)
+      "There is already a property named ~S." new-name))
+  (when (gethash new-name *property-map*)
+    (return-from create-alias))
+  (assert (gethash old-name *property-map*) (old-name)
+    "There is no property named ~S." old-name)
+  (setf (gethash new-name *property-map*)
+        (gethash old-name *property-map*)))
+
+(defun create-aliases ()
+  (loop for (old-name . new-name) in *alias-map*
+        do (create-alias new-name old-name))
+  (loop for (old-name . new-name) in *bidi-alias-map*
+        do (create-alias (format nil "BidiClass:~A" new-name)
+                         (format nil "BidiClass:~A" old-name)))
+  (loop for name in (scripts)
+        do (create-alias (format nil "Script:~A" name) name))
+  (loop for name in (loop for name being the hash-keys of *property-map*
+                          collect name)
+        unless (ppcre:scan ":" name)
+        do (create-alias (format nil "Is~A" name) name))
+  (loop for name in (code-blocks)
+        do (create-alias (format nil "In~A" name) (format nil "Block:~A" name)))
+  (loop for name in (code-blocks)
+        do (create-alias name (format nil "Block:~A" name) t))
+  (loop for name in (bidi-classes)
+        do (create-alias name (format nil "BidiClass:~A" name) t))
+  (loop for (old-name . new-name) in *bidi-alias-map*
+        do (create-alias new-name (format nil "BidiClass:~A" old-name) t)))
+
+(defun build-all-property-tests ()
+  (clrhash *property-map*)
+  (clrhash *property-tests*)
+  (install-tests)
+  (build-derived-test-functions)
+  (create-aliases))
+
+(build-all-property-tests)