clucumber 0.1.1 → 0.2.0

data/lib/clucumber/vendor/cl-unicode/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)

data/lib/clucumber/vendor/cl-unicode/api.lisp

@@ -0,0 +1,412 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/api.lisp,v 1.31 2008/07/24 14:46:20 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)
+
+(defgeneric unicode-name (c)
+  (:documentation "Returns the Unicode name of a character as a string
+or NIL if there is no name for that particular character.  C can be
+the character's code point \(a positive integer) or a \(Lisp)
+character assuming its character code is also its Unicode code
+point.")
+  (:method ((char character))
+   (unicode-name (char-code char)))
+  (:method ((code-point integer))
+   (or (gethash code-point *code-points-to-names*)
+       (maybe-compute-hangul-syllable-name code-point)
+       (maybe-compute-cjk-name code-point))))
+
+(defgeneric unicode1-name (c)
+  (:documentation "Returns the Unicode 1.0 name of a character as a
+string or NIL if there is no name for that particular character.  This
+name is only non-NIL if it is significantly different from the Unicode
+name (see UNICODE-NAME).  For control characters, sometimes the ISO
+6429 name is returned instead.
+
+C can be the character's code point \(a positive integer) or a \(Lisp)
+character assuming its character code is also its Unicode code
+point.")
+  (:method ((char character))
+   (unicode1-name (char-code char)))
+  (:method ((code-point integer))
+   (values (gethash code-point *code-points-to-unicode1-names*))))
+
+(defun character-named (name &key
+                             want-code-point-p
+                             (try-unicode1-names-p *try-unicode1-names-p*)
+                             (try-abbreviations-p *try-abbreviations-p*)
+                             (scripts-to-try *scripts-to-try*)
+                             (try-hex-notation-p *try-hex-notation-p*)
+                             (try-lisp-names-p *try-lisp-names-p*))
+  "Returns the character which has the name NAME \(a string) by
+looking up the Unicode name \(see UNICODE-NAME).
+
+If TRY-UNICODE1-NAMES is true, the Unicode 1.0 name \(see
+UNICODE1-NAME) will be used as a fallback.
+
+If TRY-ABBREVIATIONS-P is true, NAME is treated as an abbreviation as
+follows: If NAME contains a colon, it is interpreted as
+\"<script>:<short-name>\" and the function tries to look up, in turn,
+the characters named \"<script> <size> LETTER <short-name>\",
+\"<script> LETTER <short-name>\", and \"<script> <short-name>\" where
+<size> is \"SMALL\" if none of the characters in <short-name> is
+uppercase, \"CAPITAL\" otherwise.  If NAME does not contain a colon,
+the same algorithm as above is tried with NAME instead of <short-name>
+and each element of the list of strings SCRIPTS-TO-TRY as <string>.
+\(SCRIPTS-TO-TRY can also be a single string which is interpreted as a
+one-element list.)
+
+If TRY-HEX-NOTATION-P is true, NAME can be of the form \"U+<x>\" where
+<x> is a hexadecimal number with four to six digits with the obvious
+meaning.
+
+If TRY-LISP-NAMES-P is true, the function returns the character with
+the character name NAME \(if there is one) or, if NAME is exactly one
+character, it returns this character.
+
+All the keyword-governed alternatives are tried in the order they're
+described here.
+
+See also *TRY-UNICODE1-NAMES-P*, *TRY-ABBREVIATIONS-P*,
+*SCRIPTS-TO-TRY*, *TRY-HEX-NOTATION-P*, and *TRY-LISP-NAMES-P*.
+
+Returns the code point instead of the character if WANT-CODE-POINT-P
+is true.  This can be especially useful for Lisp implementations where
+CHAR-CODE-LIMIT is smaller than +CODE-POINT-LIMIT+."
+  (when (stringp scripts-to-try)
+    (setq scripts-to-try (list scripts-to-try)))
+  (let* ((canonicalized-name (canonicalize-name name))
+         (code-point (or (gethash canonicalized-name *names-to-code-points*)
+                         (maybe-find-hangul-syllable-code-point canonicalized-name)
+                         (maybe-find-cjk-code-point canonicalized-name)
+                         (and try-unicode1-names-p
+                              (gethash canonicalized-name *unicode1-names-to-code-points*))
+                         (and try-abbreviations-p
+                              (let ((*try-unicode1-names-p* try-unicode1-names-p)
+                                    (*try-abbreviations-p* nil))
+                                (try-abbreviations name scripts-to-try)))
+                         (and try-hex-notation-p
+                              (ppcre:register-groups-bind ((#'parse-hex code-point))
+                                  ("^U\\+([a-zA-Z0-9]{4,6})$" name)
+                                (and (< code-point +code-point-limit+)
+                                     code-point)))
+                         (and try-lisp-names-p
+                              (case (length name)
+                                (1 (char-code (char name 0)))
+                                (otherwise (let ((char (name-char name)))
+                                             (and char (char-code char)))))))))
+    (if want-code-point-p
+      code-point
+      (and code-point (code-char code-point)))))
+
+(defgeneric script (c)
+  (:documentation "Returns the script of a character as a string or
+NIL if there is no script for that particular character.  C can be the
+character's code point \(a positive integer) or a \(Lisp) character
+assuming its character code is also its Unicode code point.  The
+second return value \(if there is one) is the property symbol of the
+script.
+
+See also SCRIPTS.")
+  (:method ((char character))
+   (script (char-code char))))
+
+(defgeneric code-block (c)
+  (:documentation "Returns the block of a character as a string or NIL
+if there is no block for that particular character.  C can be the
+character's code point \(a positive integer) or a \(Lisp) character
+assuming its character code is also its Unicode code point.  The
+second return value \(if there is one) is the property symbol of the
+block.
+
+See also CODE-BLOCKS.")
+  (:method ((char character))
+   (code-block (char-code char))))
+
+(defgeneric age (c)
+  (:documentation "Returns the \"age\" of a character or NIL if there
+is no age entry for that particular character.  The age of a character
+is a list of two integers denoting the major and minor number of the
+Unicode version where the character first appeared.  C can be the
+character's code point \(a positive integer) or a \(Lisp) character
+assuming its character code is also its Unicode code point.")
+  (:method ((char character))
+   (age (char-code char))))
+
+(defgeneric general-category (c)
+  (:documentation "Returns the general category of a character as a
+string.  C can be the character's code point \(a positive integer) or
+a \(Lisp) character assuming its character code is also its Unicode
+code point.  The second return value is the property symbol of the
+category.
+
+See also GENERAL-CATEGORIES.")
+  (:method :around (c)
+   (multiple-value-bind (name symbol)
+       (call-next-method)
+     (cond (name (values name symbol))
+           (t (values "Cn" '#.(property-symbol "Cn"))))))
+  (:method ((char character))
+   (general-category (char-code char))))
+
+(defgeneric bidi-class (c)
+  (:documentation "Returns the bidirectional \(\"Bidi\") class of a
+character as a string or NIL if there is no bidirectional class for
+that particular character.  C can be the character's code point \(a
+positive integer) or a \(Lisp) character assuming its character code
+is also its Unicode code point.  The second return value \(if there is
+one) is the property symbol of the class.
+
+See also BIDI-CLASSES")
+  (:method ((char character))
+   (bidi-class (char-code char))))
+
+(defun bidi-mirroring-glyph (c &key want-code-point-p)
+  "Returns the Bidi mirroring glyph for a character if the character
+has the \"BidiMirrored\" property and an appropriate mirroring glyph
+is defined.  C can be the character's code point \(a positive integer)
+or a \(Lisp) character assuming its character code is also its Unicode
+code point.
+
+Returns the code point instead of the character if WANT-CODE-POINT-P
+is true.  This can be especially useful for Lisp implementations where
+CHAR-CODE-LIMIT is smaller than +CODE-POINT-LIMIT+."
+  (let ((code-point (bidi-mirroring-glyph% (ensure-code-point c))))
+    (cond ((and code-point (not want-code-point-p))
+           (code-char code-point))
+          (t code-point))))
+
+(defgeneric numeric-type (c)
+  (:documentation "Returns the numeric type of a character as a string
+or NIL if that particular character has no numeric type.  C can be the
+character's code point \(a positive integer) or a \(Lisp) character
+assuming its character code is also its Unicode code point.  The
+second return value \(if there is one) is the property symbol of the
+numeric type.")
+  (:method ((char character))
+   (numeric-type (char-code char))))
+
+(defgeneric numeric-value (c)
+  (:documentation "Returns the numeric value of a character as a Lisp
+rational or NIL \(for NaN).  C can be the character's code point \(a
+positive integer) or a \(Lisp) character assuming its character code
+is also its Unicode code point.")
+  (:method ((char character))
+   (numeric-value (char-code char))))
+
+(defgeneric combining-class (c)
+  (:documentation "Returns the combining class of a character as a
+non-negative integer.  C can be the character's code point \(a
+positive integer) or a \(Lisp) character assuming its character code
+is also its Unicode code point.")
+  (:method :around (c)
+   (or (call-next-method) 0))
+  (:method ((char character))
+   (combining-class (char-code char))))
+
+(defgeneric has-binary-property (c property)
+  (:documentation "Checks whether a character has the binary property
+PROPERTY.  C can be the character's code point \(a positive integer)
+or a \(Lisp) character assuming its character code is also its Unicode
+code point.  PROPERTY can be a string naming the property or the
+corresponding property symbol.  If a true value is returned, it is the
+property symbol.
+
+See also BINARY-PROPERTIES.")
+  (:method ((char character) property)
+   (has-binary-property (char-code char) property))
+  (:method (char (property-name string))
+   (has-binary-property char (property-symbol property-name)))
+  (:method ((code-point integer) (property-symbol symbol))
+   (find property-symbol (binary-props code-point) :test #'eq)))
+
+(defun uppercase-mapping (c &key want-code-point-p)
+  "Returns the simple uppercase mapping of a character.  C can be the
+character's code point \(a positive integer) or a \(Lisp) character
+assuming its character code is also its Unicode code point.  Returns
+the character itself if no such mapping is explicitly defined.  Note
+that case mapping only makes sense for characters with the \"LC\"
+property.
+
+Returns the code point instead of the character if WANT-CODE-POINT-P
+is true.  This can be especially useful for Lisp implementations where
+CHAR-CODE-LIMIT is smaller than +CODE-POINT-LIMIT+."
+  (mapping c 0 want-code-point-p))
+
+(defun lowercase-mapping (c &key want-code-point-p)
+  "Returns the simple lowercase mapping of a character.  C can be the
+character's code point \(a positive integer) or a \(Lisp) character
+assuming its character code is also its Unicode code point.  Returns
+the character itself if no such mapping is explicitly defined.  Note
+that case mapping only makes sense for characters with the \"LC\"
+property.
+
+Returns the code point instead of the character if WANT-CODE-POINT-P
+is true.  This can be especially useful for Lisp implementations where
+CHAR-CODE-LIMIT is smaller than +CODE-POINT-LIMIT+."
+  (mapping c 1 want-code-point-p))
+
+(defun titlecase-mapping (c &key want-code-point-p)
+  "Returns the simple titlecase mapping of a character.  C can be the
+character's code point \(a positive integer) or a \(Lisp) character
+assuming its character code is also its Unicode code point.  Returns
+the character itself if no such mapping is explicitly defined.  Note
+that case mapping only makes sense for characters with the \"LC\"
+property.
+
+Returns the code point instead of the character if WANT-CODE-POINT-P
+is true.  This can be especially useful for Lisp implementations where
+CHAR-CODE-LIMIT is smaller than +CODE-POINT-LIMIT+."
+  (mapping c 2 want-code-point-p))
+
+(defun general-categories ()
+  "Returns a sorted list of all general categories known to
+CL-UNICODE.  These are the possible return values of
+GENERAL-CATEGORY."
+  (sort (mapcar 'property-name *general-categories*) 'string-lessp))
+
+(defun scripts ()
+  "Returns a sorted list of all scripts known to CL-UNICODE.  These
+are the possible return values of SCRIPT."
+  (sort (mapcar 'property-name *scripts*) 'string-lessp))
+
+(defun code-blocks ()
+  "Returns a sorted list of all blocks known to CL-UNICODE.  These are
+the possible return values of CODE-BLOCK."
+  (sort (mapcar 'property-name *code-blocks*) 'string-lessp))
+
+(defun binary-properties ()
+  "Returns a sorted list of all binary properties known to CL-UNICODE.
+These are the allowed second arguments \(modulo canonicalization) to
+HAS-BINARY-PROPERTY."
+  (sort (mapcar 'property-name *binary-properties*) 'string-lessp))
+
+(defun bidi-classes ()
+  "Returns a sorted list of all Bidi classes known to CL-UNICODE.
+These are the possible return values of BIDI-CLASS."
+  (sort (mapcar 'property-name *bidi-classes*) 'string-lessp))
+
+(defun recognized-properties (&optional all)
+  "Returns a list of all property names known to CL-UNICODE.  These
+are the allowed second arguments \(modulo canonicalization) to
+HAS-PROPERTY.  If ALL is true, known aliases \(like \"Letter\" for
+\"L\") are also included."
+  (sort (cond (all (loop for key being the hash-keys of *property-map*
+                         collect key))
+              (t (mapcar 'property-name 
+                         (loop for key being the hash-keys of *property-tests*
+                               collect key))))       
+        'string-lessp))
+
+(defgeneric property-test (property &key errorp)
+  (:documentation "Returns a unary function which can test code points
+or Lisp characters for the property PROPERTY.  PROPERTY is interpreted
+as in HAS-PROPERTY and PROPERTY-TEST is actually used internally by
+HAS-PROPERTY but might come in handy if you need a faster way to test
+for PROPERTY \(as you're saving the time to look up the property).
+
+Returns NIL if no property named PROPERTY was found or signals an
+error if ERRORP is true.")
+  (:method ((property-name string) &key errorp)
+   (property-test (or (gethash (canonicalize-name property-name) *property-map*)
+                      (and errorp (signal-unicode-error "There is no property called ~S."
+                                                        property-name)))))
+  (:method ((property-symbol symbol) &key errorp)
+   (or (gethash property-symbol *property-tests*)
+       (and errorp (signal-unicode-error "There is no property called ~S." property-symbol)))))
+
+(defun has-property (c property)
+  "Checks whether a character has the named property PROPERTY.
+PROPERTY can be a string naming a property \(which will be used for
+look-up after canonicalization) or it can be a property symbol \(see
+PROPERTY-SYMBOL).  C can be the character's code point \(a positive
+integer) or a \(Lisp) character assuming its character code is also
+its Unicode code point.
+
+\"Properties\" in the sense of CL-UNICODE can be names of general
+categories, scripts, blocks, binary properties, or Bidi classes,
+amongst other things.  If there are a block and a script with the same
+name \(like, say, \"Cyrillic\"), the bare name denotes the script.
+Prepend \"Block:\" to the name to refer to the block.  \(You can also
+prepend \"Script:\" to refer to the script unambiguously.)  Names of
+Bidi classes must be prepended with \"BidiClass:\" if there's a
+potential for ambiguity.
+
+This function also recognizes several aliases for properties \(like
+\"Symbol\" for \"S\") and you can, as in Perl, prepend block names
+with \"In\" instead of \"Block:\" and most other properties with
+\"Is\".  See RECOGNIZED-PROPERTIES.
+
+See also PROPERTY-TEST."
+  (funcall (property-test property :errorp t) c))
+
+(defun list-all-characters (property &key want-code-point-p)
+  "Lists all character \(ordered by code point) which have the
+property PROPERTY where PROPERTY is interpreted as in HAS-PROPERTY.
+If WANT-CODE-POINT-P is true, a list of code points instead of a list
+of characters is returned.  \(If CHAR-CODE-LIMIT is smaller than
++CODE-POINT-LIMIT+ in your Lisp implementation, the list of code
+points can actually be longer than the list of characters.)."
+  (loop with test-function = (property-test property :errorp t)
+        for code-point below (if want-code-point-p +code-point-limit+ char-code-limit)
+        for thing = (if want-code-point-p code-point (code-char code-point))
+        when (and thing (funcall (the function test-function) code-point))
+        collect thing))
+
+(defmacro enable-alternative-character-syntax ()
+  "Enables an alternative Lisp character syntax which /replaces/ the
+usual syntax: After a sharpsign and a backslash have been read, at
+least one more character is read.  Reading then continues as long as
+ASCII letters, digits, underlines, hyphens, colons, or plus signs are
+read.  The resulting string is then used as input to CHARACTER-NAMED
+to produce a character.
+
+This macro expands into an EVAL-WHEN so that if you use it as a
+top-level form in a file to be loaded and/or compiled it'll do what
+you expect.  Technically, this'll push the current readtable on a
+stack so that matching calls of this macro and
+DISABLE-ALTERNATIVE-CHARACTER-SYNTAX can be nested.
+
+Note that by default the alternative character syntax is not enabled
+after loading CL-UNICODE."
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+    (%enable-alternative-character-syntax)))
+
+(defmacro disable-alternative-character-syntax ()
+  "Restores the readtable which was active before the last call to
+ENABLE-ALTERNATIVE-CHARACTER-SYNTAX.  If there was no such call, the
+standard readtable is used.
+
+This macro expands into an EVAL-WHEN so that if you use it as a
+top-level form in a file to be loaded and/or compiled it'll do what
+you expect.  Technically, this'll pop a readtable from the stack
+described in ENABLE-ALTERNATIVE-CHARACTER-SYNTAX so that matching
+calls of these macros can be nested."
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+    (%disable-alternative-character-syntax)))

data/lib/clucumber/vendor/cl-unicode/build/char-info.lisp

@@ -0,0 +1,133 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/build/char-info.lisp,v 1.5 2008/07/21 14:23:09 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)
+
+(defclass char-info ()
+  ((code-point :initarg :code-point
+               :reader code-point
+               :type fixnum
+               :documentation "The code point of the character.  This
+is redundant information, but convenient.")
+   (name :initarg :name
+         :initform nil
+         :reader name
+         :type (or string null)
+         :documentation "The name of the character - a string.")
+   (script :initform nil
+           :accessor script*
+           :type (or symbol null)
+           :documentation "The script the character belongs to - a
+property symbol.")
+   (code-block :initform nil
+               :accessor code-block*
+               :type (or symbol null)
+               :documentation "The block the character belongs to - a
+property symbol.")
+   (unicode1-name :initarg :unicode1-name
+                  :initform nil
+                  :reader unicode1-name
+                  :type (or string null)
+                  :documentation "The Unicode 1.0 name of the
+character - a string.")
+   (age :initform nil
+        :accessor age*
+        :type list
+        :documentation "The Unicode version this character first
+appeared in, a cons of two integers which denote the major and minor
+version.")
+   (general-category :initarg :general-category
+                     ;; this is the default for unassigned characters
+                     ;; - see READ-BINARY-PROPERTIES
+                     :initform (property-symbol "Cn")
+                     :reader general-category*
+                     :type symbol
+                     :documentation "The general category of this
+character - a property symbol.")
+   (bidi-class :initarg :bidi-class
+               ;; will be defaulted later, see
+               ;; SET-DEFAULT-BIDI-CLASSES
+               :initform nil
+               :accessor bidi-class*
+               :type symbol
+               :documentation "The Bidi class of the character - a
+property symbol.")
+   (bidi-mirroring-glyph :initform nil
+                         :accessor bidi-mirroring-glyph*
+                         :type (or fixnum null)
+                         :documentation "The code point of the mirror
+image of the character, if there is one.")
+   (binary-props :initarg :binary-props
+                 :initform nil
+                 :accessor binary-props*
+                 :type list
+                 :documentation "A list of property symbols denoting
+the binary properties of the character.")
+   (combining-class :initarg :combining-class
+                    ;; the default combining class
+                    :initform 0
+                    :reader combining-class*
+                    :type fixnum
+                    :documentation "The combining class of the
+character - an integer.")
+   (numeric-type :initarg :numeric-type
+                 :initform nil
+                 :reader numeric-type*
+                 :type symbol
+                 :documentation "The numeric type \(one of
+\"Decimal\", \"Digit\", or \"Numeric\") of the character if it has one
+- a property symbol.")
+   (numeric-value :initarg :numeric-value
+                  :initform nil
+                  :reader numeric-value*
+                  :type (or rational null)
+                  :documentation "The numeric value of the character
+if it has one - a Lisp rational.")
+   (uppercase-mapping :initarg :uppercase-mapping
+                      :initform nil
+                      :reader uppercase-mapping*
+                      :type (or fixnum null)
+                      :documentation "The simple uppercase mapping of
+the character \(as a code point) if explicitly specified.")
+   (lowercase-mapping :initarg :lowercase-mapping
+                      :initform nil
+                      :reader lowercase-mapping*
+                      :type (or fixnum null)
+                      :documentation "The simple lowercase mapping of
+the character \(as a code point) if explicitly specified.")
+   (titlecase-mapping :initarg :titlecase-mapping
+                      :initform nil
+                      :reader titlecase-mapping*
+                      :type (or fixnum null)
+                      :documentation "The simple titlecase mapping of
+the character \(as a code point) if explicitly specified."))
+  (:documentation "A CHAR-INFO object is a datastructure which is used
+to \(temporarily) hold the information about one character as gathered
+from parsing the Unicode data files - see the code in read.lisp."))
+