[bknr-cvs] r2520 - in branches/trunk-reorg/thirdparty:
closure-common-2007-10-21 cxml-2007-08-05 cxml-2007-10-21
cxml-2007-10-21/contrib cxml-2007-10-21/doc
cxml-2007-10-21/dom cxml-2007-10-21/klacks
cxml-2007-10-21/test cxml-2007-10-21/xml
cxml-2007-10-21/xml/sax-tests
ksprotte at common-lisp.net
ksprotte at common-lisp.net
Sun Feb 17 09:26:58 EST 2008
Author: ksprotte
Date: Sun Feb 17 09:26:33 2008
New Revision: 2520
Added:
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/characters.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/closure-common.asd
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/definline.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings-data.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/hax.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/package.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/runes.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/stream-scl.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/syntax.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/utf8.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/xstream.lisp
branches/trunk-reorg/thirdparty/closure-common-2007-10-21/ystream.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/COPYING
branches/trunk-reorg/thirdparty/cxml-2007-10-21/DOMTEST
branches/trunk-reorg/thirdparty/cxml-2007-10-21/GNUmakefile
branches/trunk-reorg/thirdparty/cxml-2007-10-21/OLDNEWS
branches/trunk-reorg/thirdparty/cxml-2007-10-21/README
branches/trunk-reorg/thirdparty/cxml-2007-10-21/TIMES
branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLCONF
branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLS-SYMBOLS.diff
branches/trunk-reorg/thirdparty/cxml-2007-10-21/catalog.dtd
branches/trunk-reorg/thirdparty/cxml-2007-10-21/contrib/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/contrib/xhtmlgen.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/cxml.asd
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/GNUmakefile
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/bg.png (contents, props changed)
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/cxml.css
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.html
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.xml
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/html.xsl
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.html
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.xml
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.html
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.xml
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.html
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.xml
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.html
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.xml
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.html
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.xml
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.html
branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.xml
branches/trunk-reorg/thirdparty/cxml-2007-10-21/documentation.css
branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-builder.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-impl.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-sax.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks-impl.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/tap-source.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/mlisp-patch.diff
branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/domtest.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/misc.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/utf8domtest.diff
branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf-base.diff
branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/catalog.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/recoder.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-handler.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-proxy.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/event-collecting-handler.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/tests.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/space-normalizer.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/split-sequence.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/unparse.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/util.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-name-rune-p.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-parse.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmlns-normalizer.lisp
branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmls-compat.lisp
Removed:
branches/trunk-reorg/thirdparty/cxml-2007-08-05/
Log:
pulled cxml-2007-10-21, latest cxml release
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/characters.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/characters.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,148 @@
+;;; copyright (c) 2004 knowledgeTools Int. GmbH
+;;; Author of this version: David Lichteblau <david at 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)
+ (if (zerop (length x))
+ (zerop (length y))
+ (and (plusp (length 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))
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/closure-common.asd
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/closure-common.asd Sun Feb 17 09:26:33 2008
@@ -0,0 +1,56 @@
+(defpackage :closure-common-system
+ (:use :asdf :cl)
+ (:export #:*utf8-runes-readtable*))
+
+(in-package :closure-common-system)
+
+(defvar *utf8-runes-readtable*)
+
+(defclass closure-source-file (cl-source-file) ())
+
+#+sbcl
+(defmethod perform :around ((o compile-op) (s closure-source-file))
+ ;; shut up already. Correctness first.
+ (handler-bind ((sb-ext:compiler-note #'muffle-warning))
+ (let (#+sbcl (*compile-print* nil))
+ (call-next-method))))
+
+#-(or rune-is-character rune-is-integer)
+(progn
+ (format t "~&;;; Checking for wide character support...")
+ (force-output)
+ (pushnew (dotimes (x 65536
+ (progn
+ (format t " ok, characters have at least 16 bits.~%")
+ :rune-is-character))
+ (unless (or (<= #xD800 x #xDFFF)
+ (and (< x char-code-limit) (code-char x)))
+ (format t " no, reverting to octet strings.~%")
+ (return :rune-is-integer)))
+ *features*))
+
+#-rune-is-character
+(format t "~&;;; Building Closure with (UNSIGNED-BYTE 16) RUNES~%")
+
+#+rune-is-character
+(format t "~&;;; Building Closure with CHARACTER RUNES~%")
+
+(defsystem :closure-common
+ :default-component-class closure-source-file
+ :serial t
+ :components
+ ((:file "package")
+ (:file "definline")
+ (:file runes
+ :pathname
+ #-rune-is-character "runes"
+ #+rune-is-character "characters")
+ #+rune-is-integer (:file "utf8")
+ (:file "syntax")
+ #-x&y-streams-are-stream (:file "encodings")
+ #-x&y-streams-are-stream (:file "encodings-data")
+ #-x&y-streams-are-stream (:file "xstream")
+ #-x&y-streams-are-stream (:file "ystream")
+ #+x&y-streams-are-stream (:file #+scl "stream-scl")
+ (:file "hax"))
+ :depends-on (#-scl :trivial-gray-streams))
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/definline.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/definline.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,63 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: definline
+;;; Created: 1999-05-25 22:32
+;;; Author: Gilbert Baumann <unk6 at rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999 by Gilbert Baumann
+
+;;; 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)
+
+#-(or allegro openmcl)
+(defmacro definline (name args &body body)
+ `(progn
+ (declaim (inline ,name))
+ (defun ,name ,args .,body)))
+
+#+openmcl
+(defmacro runes::definline (fun args &body body)
+ (if (consp fun)
+ `(defun ,fun ,args
+ , at body)
+ `(progn
+ (defun ,fun ,args .,body)
+ (define-compiler-macro ,fun (&rest .args.)
+ (cons '(lambda ,args .,body)
+ .args.)))))
+
+#+allegro
+(defmacro definline (fun args &body body)
+ (if (and (consp fun) (eq (car fun) 'setf))
+ (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
+ (symbol-package (cadr fun)))))
+ `(progn
+ (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
+ (definline ,fnam ,args .,body)))
+ (labels ((declp (x)
+ (and (consp x) (eq (car x) 'declare))))
+ `(progn
+ (defun ,fun ,args .,body)
+ (define-compiler-macro ,fun (&rest .args.)
+ (cons '(lambda ,args
+ ,@(remove-if-not #'declp body)
+ (block ,fun
+ ,@(remove-if #'declp body)))
+ .args.))))))
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings-data.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings-data.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,568 @@
+(in-package :runes-encoding)
+
+(progn
+ (add-name :us-ascii "ANSI_X3.4-1968")
+ (add-name :us-ascii "iso-ir-6")
+ (add-name :us-ascii "ANSI_X3.4-1986")
+ (add-name :us-ascii "ISO_646.irv:1991")
+ (add-name :us-ascii "ASCII")
+ (add-name :us-ascii "ISO646-US")
+ (add-name :us-ascii "US-ASCII")
+ (add-name :us-ascii "us")
+ (add-name :us-ascii "IBM367")
+ (add-name :us-ascii "cp367")
+ (add-name :us-ascii "csASCII")
+
+ (add-name :iso-8859-1 "ISO_8859-1:1987")
+ (add-name :iso-8859-1 "iso-ir-100")
+ (add-name :iso-8859-1 "ISO_8859-1")
+ (add-name :iso-8859-1 "ISO-8859-1")
+ (add-name :iso-8859-1 "latin1")
+ (add-name :iso-8859-1 "l1")
+ (add-name :iso-8859-1 "IBM819")
+ (add-name :iso-8859-1 "CP819")
+ (add-name :iso-8859-1 "csISOLatin1")
+
+ (add-name :iso-8859-2 "ISO_8859-2:1987")
+ (add-name :iso-8859-2 "iso-ir-101")
+ (add-name :iso-8859-2 "ISO_8859-2")
+ (add-name :iso-8859-2 "ISO-8859-2")
+ (add-name :iso-8859-2 "latin2")
+ (add-name :iso-8859-2 "l2")
+ (add-name :iso-8859-2 "csISOLatin2")
+
+ (add-name :iso-8859-3 "ISO_8859-3:1988")
+ (add-name :iso-8859-3 "iso-ir-109")
+ (add-name :iso-8859-3 "ISO_8859-3")
+ (add-name :iso-8859-3 "ISO-8859-3")
+ (add-name :iso-8859-3 "latin3")
+ (add-name :iso-8859-3 "l3")
+ (add-name :iso-8859-3 "csISOLatin3")
+
+ (add-name :iso-8859-4 "ISO_8859-4:1988")
+ (add-name :iso-8859-4 "iso-ir-110")
+ (add-name :iso-8859-4 "ISO_8859-4")
+ (add-name :iso-8859-4 "ISO-8859-4")
+ (add-name :iso-8859-4 "latin4")
+ (add-name :iso-8859-4 "l4")
+ (add-name :iso-8859-4 "csISOLatin4")
+
+ (add-name :iso-8859-6 "ISO_8859-6:1987")
+ (add-name :iso-8859-6 "iso-ir-127")
+ (add-name :iso-8859-6 "ISO_8859-6")
+ (add-name :iso-8859-6 "ISO-8859-6")
+ (add-name :iso-8859-6 "ECMA-114")
+ (add-name :iso-8859-6 "ASMO-708")
+ (add-name :iso-8859-6 "arabic")
+ (add-name :iso-8859-6 "csISOLatinArabic")
+
+ (add-name :iso-8859-7 "ISO_8859-7:1987")
+ (add-name :iso-8859-7 "iso-ir-126")
+ (add-name :iso-8859-7 "ISO_8859-7")
+ (add-name :iso-8859-7 "ISO-8859-7")
+ (add-name :iso-8859-7 "ELOT_928")
+ (add-name :iso-8859-7 "ECMA-118")
+ (add-name :iso-8859-7 "greek")
+ (add-name :iso-8859-7 "greek8")
+ (add-name :iso-8859-7 "csISOLatinGreek")
+
+ (add-name :iso-8859-8 "ISO_8859-8:1988")
+ (add-name :iso-8859-8 "iso-ir-138")
+ (add-name :iso-8859-8 "ISO_8859-8")
+ (add-name :iso-8859-8 "ISO-8859-8")
+ (add-name :iso-8859-8 "hebrew")
+ (add-name :iso-8859-8 "csISOLatinHebrew")
+
+ (add-name :iso-8859-5 "ISO_8859-5:1988")
+ (add-name :iso-8859-5 "iso-ir-144")
+ (add-name :iso-8859-5 "ISO_8859-5")
+ (add-name :iso-8859-5 "ISO-8859-5")
+ (add-name :iso-8859-5 "cyrillic")
+ (add-name :iso-8859-5 "csISOLatinCyrillic")
+
+ (add-name :iso-8859-9 "ISO_8859-9:1989")
+ (add-name :iso-8859-9 "iso-ir-148")
+ (add-name :iso-8859-9 "ISO_8859-9")
+ (add-name :iso-8859-9 "ISO-8859-9")
+ (add-name :iso-8859-9 "latin5")
+ (add-name :iso-8859-9 "l5")
+ (add-name :iso-8859-9 "csISOLatin5")
+
+ (add-name :iso-8859-15 "ISO_8859-15")
+ (add-name :iso-8859-15 "ISO-8859-15")
+
+ (add-name :iso-8859-14 "ISO_8859-14")
+ (add-name :iso-8859-14 "ISO-8859-14")
+
+ (add-name :koi8-r "KOI8-R")
+ (add-name :koi8-r "csKOI8R")
+
+ (add-name :utf-8 "UTF-8")
+
+ (add-name :utf-16 "UTF-16")
+
+ (add-name :ucs-4 "ISO-10646-UCS-4")
+ (add-name :ucs-4 "UCS-4")
+
+ (add-name :ucs-2 "ISO-10646-UCS-2")
+ (add-name :ucs-2 "UCS-2") )
+
+
+(progn
+ (define-encoding :iso-8859-1
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-1)))
+
+ (define-encoding :iso-8859-2
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-2)))
+
+ (define-encoding :iso-8859-3
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-3)))
+
+ (define-encoding :iso-8859-4
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-4)))
+
+ (define-encoding :iso-8859-5
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-5)))
+
+ (define-encoding :iso-8859-6
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-6)))
+
+ (define-encoding :iso-8859-7
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-7)))
+
+ (define-encoding :iso-8859-8
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-8)))
+
+ (define-encoding :iso-8859-14
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-14)))
+
+ (define-encoding :iso-8859-15
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-15)))
+
+ (define-encoding :koi8-r
+ (make-simple-8-bit-encoding
+ :charset (find-charset :koi8-r)))
+
+ (define-encoding :utf-8 :utf-8)
+ )
+
+(progn
+ (define-8-bit-charset :iso-8859-1
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x00B8 #x00B9 #x00BA #x00BB #x00BC #x00BD #x00BE #x00BF
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x00D0 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x00DE #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x00F0 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x00FE #x00FF)
+
+ (define-8-bit-charset :iso-8859-2
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0104 #x02D8 #x0141 #x00A4 #x013D #x015A #x00A7
+ #| #o25x |# #x00A8 #x0160 #x015E #x0164 #x0179 #x00AD #x017D #x017B
+ #| #o26x |# #x00B0 #x0105 #x02DB #x0142 #x00B4 #x013E #x015B #x02C7
+ #| #o27x |# #x00B8 #x0161 #x015F #x0165 #x017A #x02DD #x017E #x017C
+ #| #o30x |# #x0154 #x00C1 #x00C2 #x0102 #x00C4 #x0139 #x0106 #x00C7
+ #| #o31x |# #x010C #x00C9 #x0118 #x00CB #x011A #x00CD #x00CE #x010E
+ #| #o32x |# #x0110 #x0143 #x0147 #x00D3 #x00D4 #x0150 #x00D6 #x00D7
+ #| #o33x |# #x0158 #x016E #x00DA #x0170 #x00DC #x00DD #x0162 #x00DF
+ #| #o34x |# #x0155 #x00E1 #x00E2 #x0103 #x00E4 #x013A #x0107 #x00E7
+ #| #o35x |# #x010D #x00E9 #x0119 #x00EB #x011B #x00ED #x00EE #x010F
+ #| #o36x |# #x0111 #x0144 #x0148 #x00F3 #x00F4 #x0151 #x00F6 #x00F7
+ #| #o37x |# #x0159 #x016F #x00FA #x0171 #x00FC #x00FD #x0163 #x02D9)
+
+ (define-8-bit-charset :iso-8859-3
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0126 #x02D8 #x00A3 #x00A4 #xFFFF #x0124 #x00A7
+ #| #o25x |# #x00A8 #x0130 #x015E #x011E #x0134 #x00AD #xFFFF #x017B
+ #| #o26x |# #x00B0 #x0127 #x00B2 #x00B3 #x00B4 #x00B5 #x0125 #x00B7
+ #| #o27x |# #x00B8 #x0131 #x015F #x011F #x0135 #x00BD #xFFFF #x017C
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #xFFFF #x00C4 #x010A #x0108 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #xFFFF #x00D1 #x00D2 #x00D3 #x00D4 #x0120 #x00D6 #x00D7
+ #| #o33x |# #x011C #x00D9 #x00DA #x00DB #x00DC #x016C #x015C #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #xFFFF #x00E4 #x010B #x0109 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #xFFFF #x00F1 #x00F2 #x00F3 #x00F4 #x0121 #x00F6 #x00F7
+ #| #o37x |# #x011D #x00F9 #x00FA #x00FB #x00FC #x016D #x015D #x02D9)
+
+ (define-8-bit-charset :iso-8859-4
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0104 #x0138 #x0156 #x00A4 #x0128 #x013B #x00A7
+ #| #o25x |# #x00A8 #x0160 #x0112 #x0122 #x0166 #x00AD #x017D #x00AF
+ #| #o26x |# #x00B0 #x0105 #x02DB #x0157 #x00B4 #x0129 #x013C #x02C7
+ #| #o27x |# #x00B8 #x0161 #x0113 #x0123 #x0167 #x014A #x017E #x014B
+ #| #o30x |# #x0100 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x012E
+ #| #o31x |# #x010C #x00C9 #x0118 #x00CB #x0116 #x00CD #x00CE #x012A
+ #| #o32x |# #x0110 #x0145 #x014C #x0136 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x0172 #x00DA #x00DB #x00DC #x0168 #x016A #x00DF
+ #| #o34x |# #x0101 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x012F
+ #| #o35x |# #x010D #x00E9 #x0119 #x00EB #x0117 #x00ED #x00EE #x012B
+ #| #o36x |# #x0111 #x0146 #x014D #x0137 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x0173 #x00FA #x00FB #x00FC #x0169 #x016B #x02D9)
+
+ (define-8-bit-charset :iso-8859-5
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0401 #x0402 #x0403 #x0404 #x0405 #x0406 #x0407
+ #| #o25x |# #x0408 #x0409 #x040A #x040B #x040C #x00AD #x040E #x040F
+ #| #o26x |# #x0410 #x0411 #x0412 #x0413 #x0414 #x0415 #x0416 #x0417
+ #| #o27x |# #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E #x041F
+ #| #o30x |# #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426 #x0427
+ #| #o31x |# #x0428 #x0429 #x042A #x042B #x042C #x042D #x042E #x042F
+ #| #o32x |# #x0430 #x0431 #x0432 #x0433 #x0434 #x0435 #x0436 #x0437
+ #| #o33x |# #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E #x043F
+ #| #o34x |# #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447
+ #| #o35x |# #x0448 #x0449 #x044A #x044B #x044C #x044D #x044E #x044F
+ #| #o36x |# #x2116 #x0451 #x0452 #x0453 #x0454 #x0455 #x0456 #x0457
+ #| #o37x |# #x0458 #x0459 #x045A #x045B #x045C #x00A7 #x045E #x045F)
+
+ (define-8-bit-charset :iso-8859-6
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0660 #x0661 #x0662 #x0663 #x0664 #x0665 #x0666 #x0667
+ #| #o07x |# #x0668 #x0669 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #xFFFF #xFFFF #xFFFF #x00A4 #xFFFF #xFFFF #xFFFF
+ #| #o25x |# #xFFFF #xFFFF #xFFFF #xFFFF #x060C #x00AD #xFFFF #xFFFF
+ #| #o26x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o27x |# #xFFFF #xFFFF #xFFFF #x061B #xFFFF #xFFFF #xFFFF #x061F
+ #| #o30x |# #xFFFF #x0621 #x0622 #x0623 #x0624 #x0625 #x0626 #x0627
+ #| #o31x |# #x0628 #x0629 #x062A #x062B #x062C #x062D #x062E #x062F
+ #| #o32x |# #x0630 #x0631 #x0632 #x0633 #x0634 #x0635 #x0636 #x0637
+ #| #o33x |# #x0638 #x0639 #x063A #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o34x |# #x0640 #x0641 #x0642 #x0643 #x0644 #x0645 #x0646 #x0647
+ #| #o35x |# #x0648 #x0649 #x064A #x064B #x064C #x064D #x064E #x064F
+ #| #o36x |# #x0650 #x0651 #x0652 #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o37x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF)
+
+ (define-8-bit-charset :iso-8859-7
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x02BD #x02BC #x00A3 #xFFFF #xFFFF #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #xFFFF #x00AB #x00AC #x00AD #xFFFF #x2015
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x0384 #x0385 #x0386 #x00B7
+ #| #o27x |# #x0388 #x0389 #x038A #x00BB #x038C #x00BD #x038E #x038F
+ #| #o30x |# #x0390 #x0391 #x0392 #x0393 #x0394 #x0395 #x0396 #x0397
+ #| #o31x |# #x0398 #x0399 #x039A #x039B #x039C #x039D #x039E #x039F
+ #| #o32x |# #x03A0 #x03A1 #xFFFF #x03A3 #x03A4 #x03A5 #x03A6 #x03A7
+ #| #o33x |# #x03A8 #x03A9 #x03AA #x03AB #x03AC #x03AD #x03AE #x03AF
+ #| #o34x |# #x03B0 #x03B1 #x03B2 #x03B3 #x03B4 #x03B5 #x03B6 #x03B7
+ #| #o35x |# #x03B8 #x03B9 #x03BA #x03BB #x03BC #x03BD #x03BE #x03BF
+ #| #o36x |# #x03C0 #x03C1 #x03C2 #x03C3 #x03C4 #x03C5 #x03C6 #x03C7
+ #| #o37x |# #x03C8 #x03C9 #x03CA #x03CB #x03CC #x03CD #x03CE #xFFFF)
+
+ (define-8-bit-charset :iso-8859-8
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #xFFFF #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #x00D7 #x00AB #x00AC #x00AD #x00AE #x203E
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x00B8 #x00B9 #x00F7 #x00BB #x00BC #x00BD #x00BE #xFFFF
+ #| #o30x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o31x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o32x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o33x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #x2017
+ #| #o34x |# #x05D0 #x05D1 #x05D2 #x05D3 #x05D4 #x05D5 #x05D6 #x05D7
+ #| #o35x |# #x05D8 #x05D9 #x05DA #x05DB #x05DC #x05DD #x05DE #x05DF
+ #| #o36x |# #x05E0 #x05E1 #x05E2 #x05E3 #x05E4 #x05E5 #x05E6 #x05E7
+ #| #o37x |# #x05E8 #x05E9 #x05EA #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF)
+
+ (define-8-bit-charset :iso-8859-9
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x00B8 #x00B9 #x00BA #x00BB #x00BC #x00BD #x00BE #x00BF
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x011E #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x0130 #x015E #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x011F #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x0131 #x015F #x00FF)
+
+ (define-8-bit-charset :iso-8859-14
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x1E02 #x1E03 #x00A3 #x010A #x010B #x1E0A #x00A7
+ #| #o25x |# #x1E80 #x00A9 #x1E82 #x1E0B #x1EF2 #x00AD #x00AE #x0178
+ #| #o26x |# #x1E1E #x1E1F #x0120 #x0121 #x1E40 #x1E41 #x00B6 #x1E56
+ #| #o27x |# #x1E81 #x1E57 #x1E83 #x1E60 #x1EF3 #x1E84 #x1E85 #x1E61
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x0174 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x1E6A
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x0176 #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x0175 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x1E6B
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x0177 #x00FF)
+
+ (define-8-bit-charset :iso-8859-15
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x20AC #x00A5 #x0160 #x00A7
+ #| #o25x |# #x0161 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x017D #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x017E #x00B9 #x00BA #x00BB #x0152 #x0153 #x0178 #x00BF
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x00D0 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x00DE #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x00F0 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x00FE #x00FF)
+
+ (define-8-bit-charset :koi8-r
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
+ #| #o21x |# #x252C #x2534 #x253C #x2580 #x2584 #x2588 #x258C #x2590
+ #| #o22x |# #x2591 #x2592 #x2593 #x2320 #x25A0 #x2219 #x221A #x2248
+ #| #o23x |# #x2264 #x2265 #x00A0 #x2321 #x00B0 #x00B2 #x00B7 #x00F7
+ #| #o24x |# #x2550 #x2551 #x2552 #x0451 #x2553 #x2554 #x2555 #x2556
+ #| #o25x |# #x2557 #x2558 #x2559 #x255A #x255B #x255C #x255D #x255E
+ #| #o26x |# #x255F #x2560 #x2561 #x0401 #x2562 #x2563 #x2564 #x2565
+ #| #o27x |# #x2566 #x2567 #x2568 #x2569 #x256A #x256B #x256C #x00A9
+ #| #o30x |# #x044E #x0430 #x0431 #x0446 #x0434 #x0435 #x0444 #x0433
+ #| #o31x |# #x0445 #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E
+ #| #o32x |# #x043F #x044F #x0440 #x0441 #x0442 #x0443 #x0436 #x0432
+ #| #o33x |# #x044C #x044B #x0437 #x0448 #x044D #x0449 #x0447 #x044A
+ #| #o34x |# #x042E #x0410 #x0411 #x0426 #x0414 #x0415 #x0424 #x0413
+ #| #o35x |# #x0425 #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E
+ #| #o36x |# #x041F #x042F #x0420 #x0421 #x0422 #x0423 #x0416 #x0412
+ #| #o37x |# #x042C #x042B #x0417 #x0428 #x042D #x0429 #x0427 #x042A)
+ )
+
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,396 @@
+(in-package :runes-encoding)
+
+(define-condition encoding-error (simple-error) ())
+
+(defun xerror (fmt &rest args)
+ (error 'encoding-error :format-control fmt :format-arguments args))
+
+;;;; ---------------------------------------------------------------------------
+;;;; Encoding names
+;;;;
+
+(defvar *names* (make-hash-table :test #'eq))
+
+(defun canon-name (string)
+ (with-output-to-string (bag)
+ (map nil (lambda (ch)
+ (cond ((char= ch #\_) (write-char #\- bag))
+ (t (write-char (char-upcase ch) bag))))
+ string)))
+
+(defun canon-name-2 (string)
+ (with-output-to-string (bag)
+ (map nil (lambda (ch)
+ (cond ((char= ch #\_))
+ ((char= ch #\-))
+ (t (write-char (char-upcase ch) bag))))
+ string)))
+
+(defmethod encoding-names ((encoding symbol))
+ (gethash encoding *names*))
+
+(defmethod (setf encoding-names) (new-value (encoding symbol))
+ (setf (gethash encoding *names*) new-value))
+
+(defun add-name (encoding name)
+ (pushnew (canon-name name) (encoding-names encoding) :test #'string=))
+
+(defun resolve-name (string)
+ (cond ((symbolp string)
+ string)
+ (t
+ (setq string (canon-name string))
+ (or
+ (block nil
+ (maphash (lambda (x y)
+ (when (member string y :test #'string=)
+ (return x)))
+ *names*)
+ nil)
+ (block nil
+ (maphash (lambda (x y)
+ (when (member string y
+ :test #'(lambda (x y)
+ (string= (canon-name-2 x)
+ (canon-name-2 y))))
+ (return x)))
+ *names*)
+ nil)))))
+
+;;;; ---------------------------------------------------------------------------
+;;;; Encodings
+;;;;
+
+(defvar *encodings* (make-hash-table :test #'eq))
+
+(defmacro define-encoding (name init-form)
+ `(progn
+ (setf (gethash ',name *encodings*)
+ (list nil (lambda () ,init-form)))
+ ',name))
+
+(defun find-encoding (name)
+ (let ((x (gethash (resolve-name name) *encodings*)))
+ (and x
+ (or (first x)
+ (setf (first x) (funcall (second x)))))))
+
+(defclass encoding () ())
+
+(defclass simple-8-bit-encoding (encoding)
+ ((table :initarg :table)))
+
+(defun make-simple-8-bit-encoding (&key charset)
+ (make-instance 'simple-8-bit-encoding
+ :table (coerce (to-unicode-table charset) '(simple-array (unsigned-byte 16) (256)))))
+
+;;;;;;;
+
+(defmacro fx-op (op &rest xs)
+ `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))))
+(defmacro fx-pred (op &rest xs)
+ `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))
+
+(defmacro %+ (&rest xs) `(fx-op + , at xs))
+(defmacro %- (&rest xs) `(fx-op - , at xs))
+(defmacro %* (&rest xs) `(fx-op * , at xs))
+(defmacro %/ (&rest xs) `(fx-op floor , at xs))
+(defmacro %and (&rest xs) `(fx-op logand , at xs))
+(defmacro %ior (&rest xs) `(fx-op logior , at xs))
+(defmacro %xor (&rest xs) `(fx-op logxor , at xs))
+(defmacro %ash (&rest xs) `(fx-op ash , at xs))
+(defmacro %mod (&rest xs) `(fx-op mod , at xs))
+
+(defmacro %= (&rest xs) `(fx-pred = , at xs))
+(defmacro %<= (&rest xs) `(fx-pred <= , at xs))
+(defmacro %>= (&rest xs) `(fx-pred >= , at xs))
+(defmacro %< (&rest xs) `(fx-pred < , at xs))
+(defmacro %> (&rest xs) `(fx-pred > , at xs))
+
+;;; Decoders
+
+;; The decoders share a common signature:
+;;
+;; DECODE input input-start input-end
+;; output output-start output-end
+;; eof-p
+;; -> first-not-written ; first-not-read
+;;
+;; These decode functions should decode as much characters off `input'
+;; into the `output' as possible and return the indexes to the first
+;; not read and first not written element of `input' and `output'
+;; respectively. If there are not enough bytes in `input' to decode a
+;; full character, decoding shold be abandomed; the caller has to
+;; ensure that the remaining bytes of `input' are passed to the
+;; decoder again with more bytes appended.
+;;
+;; `eof-p' now in turn indicates, if the given input sequence, is all
+;; the producer does have and might be used to produce error messages
+;; in case of incomplete codes or decided what to do.
+;;
+;; Decoders are expected to handle the various CR/NL conventions and
+;; canonicalize each end of line into a single NL rune (#xA) in good
+;; old Lisp tradition.
+;;
+
+;; TODO: change this to an encoding class, which then might carry
+;; additional state. Stateless encodings could been represented by
+;; keywords. e.g.
+;;
+;; defmethod DECODE-SEQUENCE ((encoding (eql :utf-8)) ...)
+;;
+
+(defmethod decode-sequence ((encoding (eql :utf-16-big-endian))
+ in in-start in-end out out-start out-end eof?)
+ ;; -> new wptr, new rptr
+ (let ((wptr out-start)
+ (rptr in-start))
+ (loop
+ (when (%= wptr out-end)
+ (return))
+ (when (>= (%+ rptr 1) in-end)
+ (return))
+ (let ((hi (aref in rptr))
+ (lo (aref in (%+ 1 rptr))))
+ (setf rptr (%+ 2 rptr))
+ ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste
+ ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
+ ;; Haelfte fehlt!
+ (let ((x (logior (ash hi 8) lo)))
+ (when (or (eql x #xFFFE) (eql x #xFFFF))
+ (xerror "not a valid code point: #x~X" x))
+ (setf (aref out wptr) x))
+ (setf wptr (%+ 1 wptr))))
+ (values wptr rptr)))
+
+(defmethod decode-sequence ((encoding (eql :utf-16-little-endian))
+ in in-start in-end out out-start out-end eof?)
+ ;; -> new wptr, new rptr
+ (let ((wptr out-start)
+ (rptr in-start))
+ (loop
+ (when (%= wptr out-end)
+ (return))
+ (when (>= (%+ rptr 1) in-end)
+ (return))
+ (let ((lo (aref in (%+ 0 rptr)))
+ (hi (aref in (%+ 1 rptr))))
+ (setf rptr (%+ 2 rptr))
+ ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste
+ ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
+ ;; Haelfte fehlt!
+ (let ((x (logior (ash hi 8) lo)))
+ (when (or (eql x #xFFFE) (eql x #xFFFF))
+ (xerror "not a valid code point: #x~X" x))
+ (setf (aref out wptr) x))
+ (setf wptr (%+ 1 wptr))))
+ (values wptr rptr)))
+
+(defmethod decode-sequence ((encoding (eql :utf-8))
+ in in-start in-end out out-start out-end eof?)
+ (declare (optimize (speed 3) (safety 0))
+ (type (simple-array (unsigned-byte 8) (*)) in)
+ (type (simple-array (unsigned-byte 16) (*)) out)
+ (type fixnum in-start in-end out-start out-end))
+ (let ((wptr out-start)
+ (rptr in-start)
+ byte0)
+ (macrolet ((put (x)
+ `((lambda (x)
+ (when (or (<= #xD800 x #xDBFF)
+ (<= #xDC00 x #xDFFF))
+ (xerror "surrogate encoded in UTF-8: #x~X." x))
+ (cond ((or (%> x #x10FFFF)
+ (eql x #xFFFE)
+ (eql x #xFFFF))
+ (xerror "not a valid code point: #x~X" x))
+ ((%> x #xFFFF)
+ (setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10))
+ (aref out (%+ 1 wptr)) (%ior #xDC00 (%and x #x3FF)))
+ (setf wptr (%+ wptr 2)))
+ (t
+ (setf (aref out wptr) x)
+ (setf wptr (%+ wptr 1)))))
+ ,x))
+ (put1 (x)
+ `(progn
+ (setf (aref out wptr) ,x)
+ (setf wptr (%+ wptr 1)))))
+ (loop
+ (when (%= (+ wptr 1) out-end) (return))
+ (when (%>= rptr in-end) (return))
+ (setq byte0 (aref in rptr))
+ (cond ((= byte0 #x0D)
+ ;; CR handling
+ ;; we need to know the following character
+ (cond ((>= (%+ rptr 1) in-end)
+ ;; no characters in buffer
+ (cond (eof?
+ ;; at EOF, pass it as NL
+ (put #x0A)
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; demand more characters
+ (return))))
+ ((= (aref in (%+ rptr 1)) #x0A)
+ ;; we see CR NL, so forget this CR and the next NL will be
+ ;; inserted literally
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; singleton CR, pass it as NL
+ (put #x0A)
+ (setf rptr (%+ rptr 1)))))
+
+ ((%<= #|#b00000000|# byte0 #b01111111)
+ (put1 byte0)
+ (setf rptr (%+ rptr 1)))
+
+ ((%<= #|#b10000000|# byte0 #b10111111)
+ (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)
+ (setf rptr (%+ rptr 1)))
+
+ ((%<= #|#b11000000|# byte0 #b11011111)
+ (cond ((<= (%+ rptr 2) in-end)
+ (put
+ (dpb (ldb (byte 5 0) byte0) (byte 5 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ rptr 1))) (byte 6 0)
+ 0)))
+ (setf rptr (%+ rptr 2)))
+ (t
+ (return))))
+
+ ((%<= #|#b11100000|# byte0 #b11101111)
+ (cond ((<= (%+ rptr 3) in-end)
+ (put
+ (dpb (ldb (byte 4 0) byte0) (byte 4 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 0)
+ 0))))
+ (setf rptr (%+ rptr 3)))
+ (t
+ (return))))
+
+ ((%<= #|#b11110000|# byte0 #b11110111)
+ (cond ((<= (%+ rptr 4) in-end)
+ (put
+ (dpb (ldb (byte 3 0) byte0) (byte 3 18)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 0)
+ 0)))))
+ (setf rptr (%+ rptr 4)))
+ (t
+ (return))))
+
+ ((%<= #|#b11111000|# byte0 #b11111011)
+ (cond ((<= (%+ rptr 5) in-end)
+ (put
+ (dpb (ldb (byte 2 0) byte0) (byte 2 24)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 18)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 4 rptr))) (byte 6 0)
+ 0))))))
+ (setf rptr (%+ rptr 5)))
+ (t
+ (return))))
+
+ ((%<= #|#b11111100|# byte0 #b11111101)
+ (cond ((<= (%+ rptr 6) in-end)
+ (put
+ (dpb (ldb (byte 1 0) byte0) (byte 1 30)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 24)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 18)
+ (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 4 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 5 rptr))) (byte 6 0)
+ 0)))))))
+ (setf rptr (%+ rptr 6)))
+ (t
+ (return))))
+
+ (t
+ (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)) ) ))
+ (values wptr rptr)) )
+
+(defmethod encoding-p ((object (eql :utf-16-little-endian))) t)
+(defmethod encoding-p ((object (eql :utf-16-big-endian))) t)
+(defmethod encoding-p ((object (eql :utf-8))) t)
+
+(defmethod encoding-p ((object encoding)) t)
+
+(defmethod decode-sequence ((encoding simple-8-bit-encoding)
+ in in-start in-end
+ out out-start out-end
+ eof?)
+ (declare (optimize (speed 3) (safety 0))
+ (type (simple-array (unsigned-byte 8) (*)) in)
+ (type (simple-array (unsigned-byte 16) (*)) out)
+ (type fixnum in-start in-end out-start out-end))
+ (let ((wptr out-start)
+ (rptr in-start)
+ (byte 0)
+ (table (slot-value encoding 'table)))
+ (declare (type fixnum wptr rptr)
+ (type (unsigned-byte 8) byte)
+ (type (simple-array (unsigned-byte 16) (*)) table))
+ (loop
+ (when (%= wptr out-end) (return))
+ (when (%>= rptr in-end) (return))
+ (setq byte (aref in rptr))
+ (cond ((= byte #x0D)
+ ;; CR handling
+ ;; we need to know the following character
+ (cond ((>= (%+ rptr 1) in-end)
+ ;; no characters in buffer
+ (cond (eof?
+ ;; at EOF, pass it as NL
+ (setf (aref out wptr) #x0A)
+ (setf wptr (%+ wptr 1))
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; demand more characters
+ (return))))
+ ((= (aref in (%+ rptr 1)) #x0A)
+ ;; we see CR NL, so forget this CR and the next NL will be
+ ;; inserted literally
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; singleton CR, pass it as NL
+ (setf (aref out wptr) #x0A)
+ (setf wptr (%+ wptr 1))
+ (setf rptr (%+ rptr 1)))))
+
+ (t
+ (setf (aref out wptr) (aref table byte))
+ (setf wptr (%+ wptr 1))
+ (setf rptr (%+ rptr 1))) ))
+ (values wptr rptr)))
+
+;;;; ---------------------------------------------------------------------------
+;;;; Character sets
+;;;;
+
+(defvar *charsets* (make-hash-table :test #'eq))
+
+(defclass 8-bit-charset ()
+ ((name :initarg :name)
+ (to-unicode-table
+ :initarg :to-unicode-table
+ :reader to-unicode-table)))
+
+(defmacro define-8-bit-charset (name &rest codes)
+ (assert (= 256 (length codes)))
+ `(progn
+ (setf (gethash ',name *charsets*)
+ (make-instance '8-bit-charset
+ :name ',name
+ :to-unicode-table
+ ',(make-array 256
+ :element-type '(unsigned-byte 16)
+ :initial-contents codes)))
+ ',name))
+
+(defun find-charset (name)
+ (or (gethash name *charsets*)
+ (xerror "There is no character set named ~S." name)))
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/hax.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/hax.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,404 @@
+;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: An event API for the HTML parser, inspired by SAX
+;;; Created: 2007-10-14
+;;; Author: David Lichteblau
+;;; License: BSD
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 2005,2007 David Lichteblau
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions are
+;;; met:
+;;;
+;;; 1. Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;;
+;;; 2. 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 ``AS IS'' AND ANY EXPRESS 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 OR CONTRIBUTORS 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.
+
+(defpackage :hax
+ (:use :common-lisp)
+ (:export #:abstract-handler
+ #:default-handler
+
+ #:make-attribute
+ #:standard-attribute
+ #:find-attribute
+ #:attribute-name
+ #:attribute-value
+ #:attribute-specified-p
+
+ #:start-document
+ #:start-element
+ #:characters
+ #:end-element
+ #:end-document
+ #:comment
+
+ #+rune-is-integer
+ #:%want-strings-p))
+
+(in-package :hax)
+
+
+;;;; ATTRIBUTE
+
+(defgeneric attribute-name (attribute))
+(defgeneric attribute-value (attribute))
+(defgeneric attribute-specified-p (attribute))
+
+(defclass standard-attribute ()
+ ((name :initarg :name :accessor attribute-name)
+ (value :initarg :value :accessor attribute-value)
+ (specified-p :initarg :specified-p :accessor attribute-specified-p)))
+
+(defun make-attribute (name value &optional (specified-p t))
+ (make-instance 'standard-attribute
+ :name name
+ :value value
+ :specified-p specified-p))
+
+(defun %rod= (x y)
+ ;; allow rods *and* strings *and* null
+ (cond
+ ((zerop (length x)) (zerop (length y)))
+ ((zerop (length y)) nil)
+ ((stringp x) (string= x y))
+ (t (runes:rod= x y))))
+
+(defun find-attribute (name attrs)
+ (find name attrs :key #'attribute-name :test #'%rod=))
+
+
+;;;; ABSTRACT-HANDLER and DEFAULT-HANDLER
+
+(defclass abstract-handler () ())
+(defclass default-handler (abstract-handler) ())
+
+#+rune-is-integer
+(defgeneric %want-strings-p (handler)
+ (:method ((handler null)) nil)
+ (:method ((handler abstract-handler)) t))
+
+(defgeneric start-document (handler name public-id system-id)
+ (:method ((handler null) name public-id system-id)
+ (declare (ignore name public-id system-id))
+ nil)
+ (:method ((handler default-handler) name public-id system-id)
+ (declare (ignore name public-id system-id))
+ nil))
+
+(defgeneric start-element (handler name attributes)
+ (:method ((handler null) name attributes)
+ (declare (ignore name attributes))
+ nil)
+ (:method ((handler default-handler) name attributes)
+ (declare (ignore name attributes))
+ nil))
+
+(defgeneric characters (handler data)
+ (:method ((handler null) data)
+ (declare (ignore data))
+ nil)
+ (:method ((handler default-handler) data)
+ (declare (ignore data))
+ nil))
+
+(defgeneric end-element (handler name)
+ (:method ((handler null) name)
+ (declare (ignore name))
+ nil)
+ (:method ((handler default-handler) name)
+ (declare (ignore name))
+ nil))
+
+(defgeneric end-document (handler)
+ (:method ((handler null)) nil)
+ (:method ((handler default-handler)) nil))
+
+(defgeneric comment (handler data)
+ (:method ((handler null) data)
+ (declare (ignore data))
+ nil)
+ (:method ((handler default-handler) data)
+ (declare (ignore data))
+ nil))
+
+
+;;;; documentation
+
+(setf (documentation (find-package :hax) t)
+ "An event protocol for HTML serialization, this package is similar
+ to the SAX protocol defined by cxml for XML serialization.
+
+ (Technically, this package should have been spelled SAH, but HAX
+ sounds better.)
+
+ Note that Closure HTML is not a streaming parser yet. Documents
+ are always parsed in full before the first HAX event is emitted.
+ In spite of this restriction, the HAX API is useful for HTML
+ serialization and transformation purposes, and for integration
+ with SAX.
+
+ @begin[HAX handlers]{section}
+ @aboutclass{abstract-handler}
+ @aboutclass{default-handler}
+ @end{section}
+ @begin[The attribute protocol]{section}
+ @aboutclass{standard-attribute}
+ @aboutfun{make-attribute}
+ @aboutfun{attribute-name}
+ @aboutfun{attribute-value}
+ @aboutfun{attribute-specified-p}
+ @end{section}
+ @begin[HAX events]{section}
+ @aboutfun{start-document}
+ @aboutfun{start-element}
+ @aboutfun{end-element}
+ @aboutfun{characters}
+ @aboutfun{comment}
+ @aboutfun{end-document}
+ @end{section}")
+
+(setf (documentation 'abstract-handler 'type)
+ "@short{The superclass of all HAX handlers.}
+
+ Direct subclasses have to implement all event methods, since
+ no default methods are defined on this class.
+
+ Note that it is permissible to use handlers that are not
+ instances of this class in some circumstances.
+
+ In particular,
+ @code{nil} is a valid HAX handler and ignores all events.
+
+ In addition,
+ @a[http://common-lisp.net/project/cxml/sax.html#sax]{SAX handlers}
+ are valid HAX handlers (and vice versa), even though
+ hax:abstract-handler and sax:abstract-handler do not
+ share a specific superclass. HAX events sent to SAX handlers are
+ automatically re-signalled as XHTML SAX events, and SAX events sent
+ to HAX handlers are re-signalled as namespace-less HAX events.
+
+ However, user code should define subclasses of the documented
+ superclasses to enable the HAX/SAX bridging described above.
+
+ @see{chtml:parse}
+ @see{chtml:serialize-lhtml}
+ @see{chtml:serialize-pt}
+ @see{start-document}
+ @see{end-document}
+ @see{start-element}
+ @see{end-element}
+ @see{characters}
+ @see{comment}")
+
+(setf (documentation 'default-handler 'type)
+ "@short{A no-op HAX handler.}
+
+ This class defines methods for all HAX events that do nothing.
+ It is useful as a superclass when implementing a HAX handler that
+ is interested in only some events and not others.
+
+ @see{chtml:parse}
+ @see{chtml:serialize-lhtml}
+ @see{chtml:serialize-pt}
+ @see{start-document}
+ @see{end-document}
+ @see{start-element}
+ @see{end-element}
+ @see{characters}
+ @see{comment}")
+
+(setf (documentation 'standard-attribute 'type)
+ "@short{An implementation of the HAX attribute protocol.}
+
+ A standard class implementing the generic functions for HAX
+ attributes. Instances of this class can be passed to
+ @fun{hax:start-element} in the list of attributes.
+
+ @see-slot{attribute-name}
+ @see-slot{attribute-value}
+ @see-slot{attribute-specified-p}
+ @see-constructor{make-instance}")
+
+(setf (documentation 'make-attribute 'function)
+ "@arg[name]{a string/rod}
+ @arg[value]{a string/rod}
+ @arg[specified-p]{a boolean, default is @code{t}}
+ @return{an instance of @class{standard-attribute}.}
+ @short{Creates a HAX attribute.}
+
+ Creates an instance that can be used with the generic functions
+ for HAX attributes. The result can be passed to
+ @fun{hax:start-element} in the list of attributes.
+
+ @see{attribute-name}
+ @see{attribute-value}
+ @see{attribute-specified-p}")
+
+(setf (documentation 'find-attribute 'function)
+ "@arg[name]{a string/rod}
+ @arg[attrs]{a list of attributes}
+ @return{an attribute, or nil}
+ @short{Searches for an attribute by name.}
+
+ Returns the first attribute in @var{attrs} with the specified name,
+ or @code{nil} if no such attribute was found.
+
+ @see{attribute-name}")
+
+(setf (documentation 'attribute-name 'function)
+ "@arg[instance]{any class implementing this function}
+ @return{a string/rod}
+ @short{Return an attribute's name.}
+
+ Instances of this classes implementing this function can be passed to
+ @fun{hax:start-element} in the list of attributes.
+
+ @see{attribute-value}
+ @see{attribute-specified-p}")
+
+(setf (documentation 'attribute-value 'function)
+ "@arg[instance]{any class implementing this function}
+ @return{a string/rod}
+ @short{Return an attribute's value.}
+
+ Instances of this classes implementing this function can be passed to
+ @fun{hax:start-element} in the list of attributes.
+
+ @see{attribute-name}
+ @see{attribute-specified-p}")
+
+(setf (documentation 'attribute-specified-p 'function)
+ "@arg[instance]{any class implementing this function}
+ @return{a string/rod}
+ @short{Return whether the attribute was contained the parsed document.}
+
+ Attributes return @code{nil} here if they resulted from a default
+ value declaration in a DTD.
+
+ Instances of this classes implementing this function can be passed to
+ @fun{hax:start-element} in the list of attributes.
+
+ @see{attribute-name}
+ @see{attribute-value}")
+
+(setf (documentation 'start-document 'function)
+ "@arg[handler]{a HAX/SAX handler
+ (see @class{abstract-handler} for details)}
+ @arg[name]{root element name, a rod/string}
+ @arg[public-id]{nil or the Public ID, a rod/string}
+ @arg[system-id]{nil or the System ID/URI, a rod/string}
+ @return{unspecified}
+ @short{Signals the beginning of an HTML document.}
+
+ This is the first event sent to any handler.
+
+ If @var{system-id} is non-nil, the document includes a doctype
+ declaration.
+
+ @see{start-element}
+ @see{end-element}
+ @see{characters}
+ @see{comment}
+ @see{end-document}")
+
+(setf (documentation 'start-element 'function)
+ "@arg[handler]{a HAX/SAX handler
+ (see @class{abstract-handler} for details)}
+ @arg[name]{root element name, a rod/string}
+ @arg[attributes]{a list of attributes}
+ @return{unspecified}
+ @short{Signals the beginning of an HTML element.}
+
+ This event corresponds to the opening tag of an element.
+
+ Elements of the attribute list can have any class, but must implement
+ the generic functions for attributes. See @class{standard-attribute}
+ for the built-in attribute implementation.
+
+ @see{find-attribute}
+ @see{start-document}
+ @see{end-element}
+ @see{characters}
+ @see{comment}
+ @see{end-document}")
+
+(setf (documentation 'end-element 'function)
+ "@arg[handler]{a HAX/SAX handler
+ (see @class{abstract-handler} for details)}
+ @arg[name]{root element name, a rod/string}
+ @return{unspecified}
+ @short{Signals the end of an HTML element.}
+
+ This event corresponds to the closing tag of an element.
+
+ @see{start-document}
+ @see{start-element}
+ @see{characters}
+ @see{comment}
+ @see{end-document}")
+
+(setf (documentation 'characters 'function)
+ "@arg[handler]{a HAX/SAX handler
+ (see @class{abstract-handler} for details)}
+ @arg[data]{rod/string}
+ @return{unspecified}
+ @short{Signals character data.}
+
+ This event represents character data in a document.
+
+ @see{start-document}
+ @see{start-element}
+ @see{end-element}
+ @see{comment}
+ @see{end-document}")
+
+(setf (documentation 'comment 'function)
+ "@arg[handler]{a HAX/SAX handler
+ (see @class{abstract-handler} for details)}
+ @arg[data]{rod/string}
+ @return{unspecified}
+ @short{Signals a comment.}
+
+ This event represents a comment.
+
+ @see{start-document}
+ @see{start-element}
+ @see{end-element}
+ @see{characters}
+ @see{end-document}")
+
+(setf (documentation 'end-document 'function)
+ "@arg[handler]{a HAX/SAX handler
+ (see @class{abstract-handler} for details)}
+ @return{The return value of this function depends on the handler class.}
+ @short{Signals the end of an HTML document.}
+
+ This is the last event sent to any handler, and signals the end of
+ serialization.
+
+ The return value of this function is usually returned to user code
+ by higher-level serialization functions and can be considered the
+ result of serialization and \"return value\" of the handler.
+
+ @see{start-document}
+ @see{start-element}
+ @see{end-element}
+ @see{characters}
+ @see{comment}")
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/package.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/package.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,99 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Generating a sane DEFPACKAGE for RUNES
+;;; Created: 1999-05-25
+;;; Author: Gilbert Baumann <unk6 at rz.uni-karlsruhe.de>
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999,2000 by Gilbert Baumann
+
+(in-package :cl-user)
+
+(defpackage :runes
+ (:use :cl #-scl :trivial-gray-streams)
+ (:export #:definline
+
+ ;; runes.lisp
+ #:rune
+ #:rod
+ #:simple-rod
+ #:%rune
+ #:rod-capitalize
+ #:code-rune
+ #:rune-code
+ #:rune-downcase
+ #:rune-upcase
+ #:rod-downcase
+ #:rod-upcase
+ #:white-space-rune-p
+ #:digit-rune-p
+ #:rune=
+ #:rune<=
+ #:rune>=
+ #:rune-equal
+ #:runep
+ #:sloopy-rod-p
+ #:rod=
+ #:rod-equal
+ #:make-rod
+ #:char-rune
+ #:rune-char
+ #:rod-string
+ #:string-rod
+ #:rod-subseq
+ #:rod<
+
+ ;; xstream.lisp
+ #:xstream
+ #:make-xstream
+ #:make-rod-xstream
+ #:close-xstream
+ #:xstream-p
+ #:read-rune
+ #:peek-rune
+ #:fread-rune
+ #:fpeek-rune
+ #:consume-rune
+ #:unread-rune
+ #:xstream-position
+ #:xstream-line-number
+ #:xstream-column-number
+ #:xstream-plist
+ #:xstream-encoding
+ #:set-to-full-speed
+ #:xstream-name
+
+ ;; ystream.lisp
+ #:ystream
+ #:close-ystream
+ #:write-rune
+ #:write-rod
+ #:ystream-column
+ #:make-octet-vector-ystream
+ #:make-octet-stream-ystream
+ #:make-rod-ystream
+ #+rune-is-character #:make-character-stream-ystream
+ ;; These don't make too much sense on Unicode-enabled,
+ ;; implementations but for those applications using them anyway,
+ ;; I have commented out the reader conditionals now:
+ ;; #+rune-is-integer
+ #:make-string-ystream/utf8
+ ;; #+rune-is-integer
+ #:make-character-stream-ystream/utf8
+ #:runes-to-utf8/adjustable-string
+
+ #:rod-to-utf8-string
+ #:utf8-string-to-rod
+ #:make-octet-input-stream))
+
+(defpackage :utf8-runes
+ (:use :cl)
+ (:export *utf8-runes-readtable*
+ #:rune #:rod #:simple-rod #:rod-string #:rod= #:make-rod
+ #:string-rod))
+
+(defpackage :runes-encoding
+ (:use :cl :runes)
+ (:export
+ #:encoding-error
+ #:find-encoding
+ #:decode-sequence))
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/runes.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/runes.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,230 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Unicode strings (called RODs)
+;;; Created: 1999-05-25 22:29
+;;; Author: Gilbert Baumann <unk6 at rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1998,1999 by Gilbert Baumann
+
+;;; 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
+
+;; Changes
+;;
+;; When Who What
+;; ----------------------------------------------------------------------------
+;; 1999-08-15 GB - ROD=, ROD-EQUAL
+;; RUNE<=, RUNE>=
+;; MAKE-ROD, ROD-SUBSEQ
+;; CHAR-RUNE, RUNE-CHAR, ROD-STRING, STRING-ROD
+;; new functions
+;; - Added rune reader
+;;
+
+(in-package :runes)
+
+(deftype rune () '(unsigned-byte 16))
+(deftype rod () '(array rune (*)))
+(deftype simple-rod () '(simple-array rune (*)))
+
+(definline rune (rod index)
+ (aref rod index))
+
+(defun (setf rune) (new rod index)
+ (setf (aref rod index) new))
+
+(definline %rune (rod index)
+ (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index)))
+
+(definline (setf %rune) (new rod index)
+ (setf (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index)) new))
+
+(defun rod-capitalize (rod)
+ (warn "~S is not implemented." 'rod-capitalize)
+ rod)
+
+(definline code-rune (x) x)
+(definline rune-code (x) x)
+
+(definline rune= (x y)
+ (= x y))
+
+(defun rune-downcase (rune)
+ (cond ((<= #x0041 rune #x005a) (+ rune #x20))
+ ((= rune #x00d7) rune)
+ ((<= #x00c0 rune #x00de) (+ rune #x20))
+ (t rune)))
+
+(definline rune-upcase (rune)
+ (cond ((<= #x0061 rune #x007a) (- rune #x20))
+ ((= rune #x00f7) rune)
+ ((<= #x00e0 rune #x00fe) (- rune #x20))
+ (t rune)))
+
+(defun rune-upper-case-letter-p (rune)
+ (or (<= #x0041 rune #x005a) (<= #x00c0 rune #x00de)))
+
+(defun rune-lower-case-letter-p (rune)
+ (or (<= #x0061 rune #x007a) (<= #x00e0 rune #x00fe)
+ (= rune #x00d7)))
+
+
+(defun rune-equal (x y)
+ (rune= (rune-upcase x) (rune-upcase y)))
+
+(defun rod-downcase (rod)
+ ;; FIXME
+ (map '(simple-array (unsigned-byte 16) (*)) #'rune-downcase rod))
+
+(defun rod-upcase (rod)
+ ;; FIXME
+ (map '(simple-array (unsigned-byte 16) (*)) #'rune-upcase rod))
+
+(definline white-space-rune-p (char)
+ (or (= char 9) ;TAB
+ (= char 10) ;Linefeed
+ (= char 13) ;Carriage Return
+ (= char 32))) ;Space
+
+(definline digit-rune-p (char &optional (radix 10))
+ (cond ((<= #.(char-code #\0) char #.(char-code #\9))
+ (and (< (- char #.(char-code #\0)) radix)
+ (- char #.(char-code #\0))))
+ ((<= #.(char-code #\A) char #.(char-code #\Z))
+ (and (< (- char #.(char-code #\A) -10) radix)
+ (- char #.(char-code #\A) -10)))
+ ((<= #.(char-code #\a) char #.(char-code #\z))
+ (and (< (- char #.(char-code #\a) -10) radix)
+ (- char #.(char-code #\a) -10))) ))
+
+(defun rod (x)
+ (cond ((stringp x) (map 'rod #'char-code x))
+ ((symbolp x) (rod (string x)))
+ ((characterp x) (rod (string x)))
+ ((vectorp x) (coerce x 'rod))
+ ((integerp x) (map 'rod #'identity (list x)))
+ (t (error "Cannot convert ~S to a ~S" x 'rod))))
+
+(defun runep (x)
+ (and (integerp x)
+ (<= 0 x #xFFFF)))
+
+(defun sloopy-rod-p (x)
+ (and (not (stringp x))
+ (vectorp x)
+ (every #'runep x)))
+
+(defun rod= (x y)
+ (and (= (length x) (length y))
+ (dotimes (i (length x) t)
+ (unless (rune= (rune x i) (rune y i))
+ (return nil)))))
+
+(defun rod-equal (x y)
+ (and (= (length x) (length y))
+ (dotimes (i (length x) t)
+ (unless (rune-equal (rune x i) (rune y i))
+ (return nil)))))
+
+(definline make-rod (size)
+ (make-array size :element-type 'rune))
+
+(defun char-rune (char)
+ (code-rune (char-code char)))
+
+(defparameter *invalid-rune* nil ;;#\?
+ "Rune to use as a replacement in RUNE-CHAR and ROD-STRING for runes not
+ representable as characters. If NIL, an error is signalled instead.")
+
+(defun rune-char (rune &optional (default *invalid-rune*))
+ (or (if (>= rune char-code-limit)
+ default
+ (or (code-char rune) default))
+ (error "rune cannot be represented as a character: ~A" rune)))
+
+(defun rod-string (rod &optional (default-char *invalid-rune*))
+ (map 'string (lambda (x) (rune-char x default-char)) rod))
+
+(defun string-rod (string)
+ (let* ((n (length string))
+ (res (make-rod n)))
+ (dotimes (i n)
+ (setf (%rune res i) (char-rune (char string i))))
+ res))
+
+;;;;
+
+(defun rune<= (rune &rest more-runes)
+ (apply #'<= rune more-runes))
+
+(defun rune>= (rune &rest more-runes)
+ (apply #'>= rune more-runes))
+
+(defun rodp (object)
+ (typep object 'rod))
+
+(defun rod-subseq (source start &optional (end (length source)))
+ (unless (rodp source)
+ (error "~S is not of type ~S." source 'rod))
+ (unless (and (typep start 'fixnum) (>= start 0))
+ (error "~S is not a non-negative fixnum." start))
+ (unless (and (typep end 'fixnum) (>= end start))
+ (error "END argument, ~S, is not a fixnum no less than START, ~S." end start))
+ (when (> start (length source))
+ (error "START argument, ~S, should be no greater than length of rod." start))
+ (when (> end (length source))
+ (error "END argument, ~S, should be no greater than length of rod." end))
+ (locally
+ (declare (type rod source)
+ (type fixnum start end))
+ (let ((res (make-rod (- end start))))
+ (declare (type rod res))
+ (do ((i (- (- end start) 1) (the fixnum (- i 1))))
+ ((< i 0) res)
+ (declare (type fixnum i))
+ (setf (%rune res i) (%rune source (the fixnum (+ i start))))))))
+
+(defun rod-subseq* (source start &optional (end (length source)))
+ (unless (and (typep start 'fixnum) (>= start 0))
+ (error "~S is not a non-negative fixnum." start))
+ (unless (and (typep end 'fixnum) (>= end start))
+ (error "END argument, ~S, is not a fixnum no less than START, ~S." end start))
+ (when (> start (length source))
+ (error "START argument, ~S, should be no greater than length of rod." start))
+ (when (> end (length source))
+ (error "END argument, ~S, should be no greater than length of rod." end))
+ (locally
+ (declare (type fixnum start end))
+ (let ((res (make-rod (- end start))))
+ (declare (type rod res))
+ (do ((i (- (- end start) 1) (the fixnum (- i 1))))
+ ((< i 0) res)
+ (declare (type fixnum i))
+ (setf (%rune res i) (aref source (the fixnum (+ i start))))))))
+
+(defun rod< (rod1 rod2)
+ (do ((i 0 (+ i 1)))
+ (nil)
+ (cond ((= i (length rod1))
+ (return t))
+ ((= i (length rod2))
+ (return nil))
+ ((< (aref rod1 i) (aref rod2 i))
+ (return t))
+ ((> (aref rod1 i) (aref rod2 i))
+ (return nil)))))
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/stream-scl.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/stream-scl.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,253 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Fast streams
+;;; Created: 1999-07-17
+;;; Author: Douglas Crosher
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 2007 by Douglas Crosher
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library 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
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :runes)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *fast* '(optimize (speed 3) (safety 3))))
+
+(deftype runes-encoding:encoding-error ()
+ 'ext:character-conversion-error)
+
+
+;;; xstream
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+(defclass xstream (ext:character-stream)
+ ((name :initarg :name :initform nil
+ :accessor xstream-name)
+ (column :initarg :column :initform 0)
+ (line :initarg :line :initform 1)
+ (unread-column :initarg :unread-column :initform 0)))
+
+(defclass eol-conversion-xstream (lisp::eol-conversion-input-stream xstream)
+ ())
+
+) ; eval-when
+
+(defun make-eol-conversion-xstream (source-stream)
+ "Returns a character stream that conversion CR-LF pairs and lone CR
+ characters into single linefeed character."
+ (declare (type stream source-stream))
+ (let ((stream (ext:make-eol-conversion-stream source-stream
+ :input t
+ :close-stream-p t)))
+ (change-class stream 'eol-conversion-xstream)))
+
+(definline xstream-p (stream)
+ (typep stream 'xstream))
+
+(defun close-xstream (input)
+ (close input))
+
+(definline read-rune (input)
+ (declare (type stream input)
+ (inline read-char)
+ #.*fast*)
+ (let ((char (read-char input nil :eof)))
+ (cond ((member char '(#\UFFFE #\UFFFF))
+ ;; These characters are illegal within XML documents.
+ (simple-error 'ext:character-conversion-error
+ "~@<Illegal XML document character: ~S~:@>" char))
+ ((eql char #\linefeed)
+ (setf (slot-value input 'unread-column) (slot-value input 'column))
+ (setf (slot-value input 'column) 0)
+ (incf (the kernel:index (slot-value input 'line))))
+ (t
+ (incf (the kernel:index (slot-value input 'column)))))
+ char))
+
+(definline peek-rune (input)
+ (declare (type stream input)
+ (inline peek-char)
+ #.*fast*)
+ (peek-char nil input nil :eof))
+
+(definline consume-rune (input)
+ (declare (type stream input)
+ (inline read-rune)
+ #.*fast*)
+ (read-rune input)
+ nil)
+
+(definline unread-rune (rune input)
+ (declare (type stream input)
+ (inline unread-char)
+ #.*fast*)
+ (unread-char rune input)
+ (cond ((eql rune #\linefeed)
+ (setf (slot-value input 'column) (slot-value input 'unread-column))
+ (setf (slot-value input 'unread-column) 0)
+ (decf (the kernel:index (slot-value input 'line))))
+ (t
+ (decf (the kernel:index (slot-value input 'column)))))
+ nil)
+
+(defun fread-rune (input)
+ (read-rune input))
+
+(defun fpeek-rune (input)
+ (peek-rune input))
+
+(defun xstream-position (input)
+ (file-position input))
+
+(defun runes-encoding:find-encoding (encoding)
+ encoding)
+
+(defun make-xstream (os-stream &key name
+ (speed 8192)
+ (initial-speed 1)
+ (initial-encoding :guess))
+ (declare (ignore speed))
+ (assert (eql initial-speed 1))
+ (assert (eq initial-encoding :guess))
+ (let* ((stream (ext:make-xml-character-conversion-stream os-stream
+ :input t
+ :close-stream-p t))
+ (xstream (make-eol-conversion-xstream stream)))
+ (setf (xstream-name xstream) name)
+ xstream))
+
+
+(defclass xstream-string-input-stream (lisp::string-input-stream xstream)
+ ())
+
+(defun make-rod-xstream (string &key name)
+ (declare (type string string))
+ (let ((stream (make-string-input-stream string)))
+ (change-class stream 'xstream-string-input-stream :name name)))
+
+;;; already at 'full speed' so just return the buffer size.
+(defun set-to-full-speed (stream)
+ (length (ext:stream-in-buffer stream)))
+
+(defun xstream-speed (stream)
+ (length (ext:stream-in-buffer stream)))
+
+(defun xstream-line-number (stream)
+ (slot-value stream 'line))
+
+(defun xstream-column-number (stream)
+ (slot-value stream 'column))
+
+(defun xstream-encoding (stream)
+ (stream-external-format stream))
+
+;;; the encoding will have already been detected, but it is checked against the
+;;; declared encoding here.
+(defun (setf xstream-encoding) (declared-encoding stream)
+ (let* ((initial-encoding (xstream-encoding stream))
+ (canonical-encoding
+ (cond ((and (eq initial-encoding :utf-16le)
+ (member declared-encoding '(:utf-16 :utf16 :utf-16le :utf16le)
+ :test 'string-equal))
+ :utf-16le)
+ ((and (eq initial-encoding :utf-16be)
+ (member declared-encoding '(:utf-16 :utf16 :utf-16be :utf16be)
+ :test 'string-equal))
+ :utf-16be)
+ ((and (eq initial-encoding :ucs-4be)
+ (member declared-encoding '(:ucs-4 :ucs4 :ucs-4be :ucs4be)
+ :test 'string-equal))
+ :ucs4-be)
+ ((and (eq initial-encoding :ucs-4le)
+ (member declared-encoding '(:ucs-4 :ucs4 :ucs-4le :ucs4le)
+ :test 'string-equal))
+ :ucs4-le)
+ (t
+ declared-encoding))))
+ (unless (string-equal initial-encoding canonical-encoding)
+ (warn "Unable to change xstream encoding from ~S to ~S (~S)~%"
+ initial-encoding declared-encoding canonical-encoding))
+ declared-encoding))
+
+
+;;; ystream - a run output stream.
+
+(deftype ystream () 'stream)
+
+(defun ystream-column (stream)
+ (ext:line-column stream))
+
+(definline write-rune (rune stream)
+ (declare (inline write-char))
+ (write-char rune stream))
+
+(defun write-rod (rod stream)
+ (declare (type rod rod)
+ (type stream stream))
+ (write-string rod stream))
+
+(defun make-rod-ystream ()
+ (make-string-output-stream))
+
+(defun close-ystream (stream)
+ (etypecase stream
+ (ext:string-output-stream
+ (get-output-stream-string stream))
+ (ext:character-conversion-output-stream
+ (let ((target (slot-value stream 'stream)))
+ (close stream)
+ (if (typep target 'ext:byte-output-stream)
+ (ext:get-output-stream-bytes target)
+ stream)))))
+
+;;;; CHARACTER-STREAM-YSTREAM
+
+(defun make-character-stream-ystream (target-stream)
+ target-stream)
+
+
+;;;; OCTET-VECTOR-YSTREAM
+
+(defun make-octet-vector-ystream ()
+ (let ((target (ext:make-byte-output-stream)))
+ (ext:make-character-conversion-stream target :output t
+ :external-format :utf-8
+ :close-stream-p t)))
+
+;;;; OCTET-STREAM-YSTREAM
+
+(defun make-octet-stream-ystream (os-stream)
+ (ext:make-character-conversion-stream os-stream :output t
+ :external-format :utf-8
+ :close-stream-p t))
+
+
+;;;; helper functions
+
+(defun rod-to-utf8-string (rod)
+ (ext:make-string-from-bytes (ext:make-bytes-from-string rod :utf8)
+ :iso-8859-1))
+
+(defun utf8-string-to-rod (str)
+ (let ((bytes (map '(vector (unsigned-byte 8)) #'char-code str)))
+ (ext:make-string-from-bytes bytes :utf-8)))
+
+(defun make-octet-input-stream (octets)
+ (ext:make-byte-input-stream octets))
+
+
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/syntax.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/syntax.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,181 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Unicode strings (called RODs)
+;;; Created: 1999-05-25 22:29
+;;; Author: Gilbert Baumann <unk6 at rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1998,1999 by Gilbert Baumann
+
+;;; 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
+
+;; Changes
+;;
+;; When Who What
+;; ----------------------------------------------------------------------------
+;; 1999-08-15 GB - ROD=, ROD-EQUAL
+;; RUNE<=, RUNE>=
+;; MAKE-ROD, ROD-SUBSEQ
+;; CHAR-RUNE, RUNE-CHAR, ROD-STRING, STRING-ROD
+;; new functions
+;; - Added rune reader
+;;
+
+(in-package :runes)
+
+;;;;
+;;;; RUNE Reader
+;;;;
+
+;; Portable implementation of WHITE-SPACE-P with regard to the current
+;; read table -- this is bit tricky.
+
+(defun rt-white-space-p (char)
+ (let ((stream (make-string-input-stream (string char))))
+ (eq :eof (peek-char t stream nil :eof))))
+
+(defun read-rune-name (input)
+ ;; the first char is unconditionally read
+ (let ((char0 (read-char input t nil t)))
+ (when (char= char0 #\\)
+ (setf char0 (read-char input t nil t)))
+ (with-output-to-string (res)
+ (write-char char0 res)
+ (do ((ch (peek-char nil input nil :eof t) (peek-char nil input nil :eof t)))
+ ((or (eq ch :eof)
+ (rt-white-space-p ch)
+ (multiple-value-bind (function non-terminating-p) (get-macro-character ch)
+ (and function (not non-terminating-p)))))
+ (write-char ch res)
+ (read-char input))))) ;consume this character
+
+(defun iso-10646-char-code (char)
+ (char-code char))
+
+(defvar *rune-names* (make-hash-table :test #'equal)
+ "Hashtable, which maps all known rune names to rune codes;
+ Names are stored in uppercase.")
+
+(defun define-rune-name (name code)
+ (setf (gethash (string-upcase name) *rune-names*) code)
+ name)
+
+(defun lookup-rune-name (name)
+ (gethash (string-upcase name) *rune-names*))
+
+(define-rune-name "null" #x0000)
+(define-rune-name "space" #x0020)
+(define-rune-name "newline" #x000A)
+(define-rune-name "return" #x000D)
+(define-rune-name "tab" #x0009)
+(define-rune-name "page" #x000C)
+
+;; and just for fun:
+(define-rune-name "euro" #x20AC)
+
+;; ASCII control characters
+(define-rune-name "nul" #x0000) ;null
+(define-rune-name "soh" #x0001) ;start of header
+(define-rune-name "stx" #x0002) ;start of text
+(define-rune-name "etx" #x0003) ;end of text
+(define-rune-name "eot" #x0004) ;end of transmission
+(define-rune-name "enq" #x0005) ;
+(define-rune-name "ack" #x0006) ;acknowledge
+(define-rune-name "bel" #x0007) ;bell
+(define-rune-name "bs" #x0008) ;backspace
+(define-rune-name "ht" #x0009) ;horizontal tab
+(define-rune-name "lf" #X000A) ;line feed, new line
+(define-rune-name "vt" #X000B) ;vertical tab
+(define-rune-name "ff" #x000C) ;form feed
+(define-rune-name "cr" #x000D) ;carriage return
+(define-rune-name "so" #x000E) ;shift out
+(define-rune-name "si" #x000F) ;shift in
+(define-rune-name "dle" #x0010) ;device latch enable ?
+(define-rune-name "dc1" #x0011) ;device control 1
+(define-rune-name "dc2" #x0012) ;device control 2
+(define-rune-name "dc3" #x0013) ;device control 3
+(define-rune-name "dc4" #x0014) ;device control 4
+(define-rune-name "nak" #x0015) ;negative acknowledge
+(define-rune-name "syn" #x0016) ;
+(define-rune-name "etb" #x0017) ;
+(define-rune-name "can" #x0018) ;
+(define-rune-name "em" #x0019) ;end of message
+(define-rune-name "sub" #x001A) ;
+(define-rune-name "esc" #x001B) ;escape
+(define-rune-name "fs" #x001C) ;field separator ?
+(define-rune-name "gs" #x001D) ;group separator
+(define-rune-name "rs" #x001E) ;
+(define-rune-name "us" #x001F) ;
+
+(define-rune-name "del" #x007F) ;delete
+
+;; iso-latin
+(define-rune-name "nbsp" #x00A0) ;non breakable space
+(define-rune-name "shy" #x00AD) ;soft hyphen
+
+(defun rune-from-read-name (name)
+ (code-rune
+ (cond ((= (length name) 1)
+ (iso-10646-char-code (char name 0)))
+ ((and (= (length name) 2)
+ (char= (char name 0) #\\))
+ (iso-10646-char-code (char name 1)))
+ ((and (>= (length name) 3)
+ (char-equal (char name 0) #\u)
+ (char-equal (char name 1) #\+)
+ (every (lambda (x) (digit-char-p x 16)) (subseq name 2)))
+ (parse-integer name :start 2 :radix 16))
+ ((lookup-rune-name name))
+ (t
+ (error "Meaningless rune name ~S." name)))))
+
+(defun rune-reader (stream subchar arg)
+ subchar arg
+ (values (rune-from-read-name (read-rune-name stream))))
+
+(set-dispatch-macro-character #\# #\/ 'rune-reader)
+
+;;; ROD ext syntax
+
+(defun rod-reader (stream subchar arg)
+ (declare (ignore arg))
+ (rod
+ (with-output-to-string (bag)
+ (do ((c (read-char stream t nil t)
+ (read-char stream t nil t)))
+ ((char= c subchar))
+ (cond ((char= c #\\)
+ (setf c (read-char stream t nil t))))
+ (princ c bag)))))
+
+#-rune-is-character
+(defun rod-printer (stream rod)
+ (princ #\# stream)
+ (princ #\" stream)
+ (loop for x across rod do
+ (cond ((or (rune= x #.(char-rune #\\))
+ (rune= x #.(char-rune #\")))
+ (princ #\\ stream)
+ (princ (code-char x) stream))
+ ((< x char-code-limit)
+ (princ (code-char x) stream))
+ (t
+ (format stream "\\u~4,'0X" x))))
+ (princ #\" stream))
+
+(set-dispatch-macro-character #\# #\" 'rod-reader)
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/utf8.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/utf8.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,36 @@
+;;; copyright (c) 2005 David Lichteblau <david at lichteblau.com>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;;
+;;; Rune emulation for the UTF-8-compatible DOM implementation.
+;;; Used only with 8 bit characters on non-unicode Lisps.
+
+(in-package :utf8-runes)
+
+(deftype rune () 'character)
+(deftype rod () '(vector rune))
+(deftype simple-rod () '(simple-array rune))
+
+(defun rod= (r s)
+ (string= r s))
+
+(defun rod-string (rod &optional default)
+ (declare (ignore default))
+ rod)
+
+(defun string-rod (string)
+ string)
+
+(defun make-rod (size)
+ (make-string size :element-type 'rune))
+
+(defun rune-reader (stream subchar arg)
+ (runes::rune-char (runes::rune-reader stream subchar arg)))
+
+(defun rod-reader (stream subchar arg)
+ (runes::rod-string (runes::rod-reader stream subchar arg)))
+
+(setf closure-common-system:*utf8-runes-readtable*
+ (let ((rt (copy-readtable)))
+ (set-dispatch-macro-character #\# #\/ 'rune-reader rt)
+ (set-dispatch-macro-character #\# #\" 'rod-reader rt)
+ rt))
Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/xstream.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/xstream.lisp Sun Feb 17 09:26:33 2008
@@ -0,0 +1,411 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Fast streams
+;;; Created: 1999-07-17
+;;; Author: Gilbert Baumann <unk6 at rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999 by Gilbert Baumann
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library 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
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :runes)
+
+;;; API
+;;
+;; MAKE-XSTREAM cl-stream &key name! speed initial-speed initial-encoding
+;; [function]
+;; MAKE-ROD-XSTREAM rod &key name [function]
+;; CLOSE-XSTREAM xstream [function]
+;; XSTREAM-P object [function]
+;;
+;; READ-RUNE xstream [macro]
+;; PEEK-RUNE xstream [macro]
+;; FREAD-RUNE xstream [function]
+;; FPEEK-RUNE xstream [function]
+;; CONSUME-RUNE xstream [macro]
+;; UNREAD-RUNE rune xstream [function]
+;;
+;; XSTREAM-NAME xstream [accessor]
+;; XSTREAM-POSITION xstream [function]
+;; XSTREAM-LINE-NUMBER xstream [function]
+;; XSTREAM-COLUMN-NUMBER xstream [function]
+;; XSTREAM-PLIST xstream [accessor]
+;; XSTREAM-ENCODING xstream [accessor] <-- be careful here. [*]
+;; SET-TO-FULL-SPEED xstream [function]
+
+;; [*] switching the encoding on the fly is only possible when the
+;; stream's buffer is empty; therefore to be able to switch the
+;; encoding, while some runes are already read, set the stream's speed
+;; to 1 initially (via the initial-speed argument for MAKE-XSTREAM)
+;; and later set it to full speed. (The encoding of the runes
+;; sequence, you fetch off with READ-RUNE is always UTF-16 though).
+;; After switching the encoding, SET-TO-FULL-SPEED can be used to bump the
+;; speed up to a full buffer length.
+
+;; An encoding is simply something, which provides the DECODE-SEQUENCE
+;; method.
+
+;;; Controller protocol
+;;
+;; READ-OCTECTS sequence os-stream start end -> first-non-written
+;; XSTREAM/CLOSE os-stream
+;;
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *fast* '(optimize (speed 3) (safety 0))))
+
+;; Let us first define fast fixnum arithmetric get rid of type
+;; checks. (After all we know what we do here).
+
+(defmacro fx-op (op &rest xs)
+ `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))))
+(defmacro fx-pred (op &rest xs)
+ `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))
+
+(defmacro %+ (&rest xs) `(fx-op + , at xs))
+(defmacro %= (&rest xs) `(fx-pred = , at xs))
+
+(deftype buffer-index ()
+ `(unsigned-byte ,(integer-length array-total-size-limit)))
+
+(deftype buffer-byte ()
+ `(unsigned-byte 16))
+
+(deftype octet ()
+ `(unsigned-byte 8))
+
+;; The usage of a special marker for EOF is experimental and
+;; considered unhygenic.
+
+(defconstant +end+ #xFFFF
+ "Special marker inserted into stream buffers to indicate end of buffered data.")
+
+(defvar +null-buffer+ (make-array 0 :element-type 'buffer-byte))
+(defvar +null-octet-buffer+ (make-array 0 :element-type 'octet))
+
+(defstruct (xstream
+ (:constructor make-xstream/low)
+ (:copier nil)
+ (:print-function print-xstream))
+
+ ;;; Read buffer
+
+ ;; the buffer itself
+ (buffer +null-buffer+
+ :type (simple-array buffer-byte (*)))
+ ;; points to the next element of `buffer' containing the next rune
+ ;; about to be read.
+ (read-ptr 0 :type buffer-index)
+ ;; points to the first element of `buffer' not containing a rune to
+ ;; be read.
+ (fill-ptr 0 :type buffer-index)
+
+ ;;; OS buffer
+
+ ;; a scratch pad for READ-SEQUENCE
+ (os-buffer +null-octet-buffer+
+ :type (simple-array octet (*)))
+
+ ;; `os-left-start', `os-left-end' designate a region of os-buffer,
+ ;; which still contains some undecoded data. This is needed because
+ ;; of the DECODE-SEQUENCE protocol
+ (os-left-start 0 :type buffer-index)
+ (os-left-end 0 :type buffer-index)
+
+ ;; How much to read each time
+ (speed 0 :type buffer-index)
+ (full-speed 0 :type buffer-index)
+
+ ;; Some stream object obeying to a certain protcol
+ os-stream
+
+ ;; The external format
+ ;; (some object offering the ENCODING protocol)
+ (encoding :utf-8)
+
+ ;;A STREAM-NAME object
+ (name nil)
+
+ ;; a plist a struct keeps the hack away
+ (plist nil)
+
+ ;; Stream Position
+ (line-number 1 :type integer) ;current line number
+ (line-start 0 :type integer) ;stream position the current line starts at
+ (buffer-start 0 :type integer) ;stream position the current buffer starts at
+
+ ;; There is no need to maintain a column counter for each character
+ ;; read, since we can easily compute it from `line-start' and
+ ;; `buffer-start'.
+ )
+
+(defun print-xstream (self sink depth)
+ (declare (ignore depth))
+ (format sink "#<~S ~S>" (type-of self) (xstream-name self)))
+
+(defmacro read-rune (input)
+ "Read a single rune off the xstream `input'. In case of end of file :EOF
+ is returned."
+ `((lambda (input)
+ (declare (type xstream input)
+ #.*fast*)
+ (let ((rp (xstream-read-ptr input)))
+ (declare (type buffer-index rp))
+ (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
+ rp)))
+ (declare (type buffer-byte ch))
+ (setf (xstream-read-ptr input) (%+ rp 1))
+ (cond ((%= ch +end+)
+ (the (or (member :eof) rune)
+ (xstream-underflow input)))
+ ((%= ch #x000A) ;line break
+ (account-for-line-break input)
+ (code-rune ch))
+ (t
+ (code-rune ch))))))
+ ,input))
+
+(defmacro peek-rune (input)
+ "Peek a single rune off the xstream `input'. In case of end of file :EOF
+ is returned."
+ `((lambda (input)
+ (declare (type xstream input)
+ #.*fast*)
+ (let ((rp (xstream-read-ptr input)))
+ (declare (type buffer-index rp))
+ (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
+ rp)))
+ (declare (type buffer-byte ch))
+ (cond ((%= ch +end+)
+ (prog1
+ (the (or (member :eof) rune) (xstream-underflow input))
+ (setf (xstream-read-ptr input) 0)))
+ (t
+ (code-rune ch))))))
+ ,input))
+
+(defmacro consume-rune (input)
+ "Like READ-RUNE, but does not actually return the read rune."
+ `((lambda (input)
+ (declare (type xstream input)
+ #.*fast*)
+ (let ((rp (xstream-read-ptr input)))
+ (declare (type buffer-index rp))
+ (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
+ rp)))
+ (declare (type buffer-byte ch))
+ (setf (xstream-read-ptr input) (%+ rp 1))
+ (when (%= ch +end+)
+ (xstream-underflow input))
+ (when (%= ch #x000A) ;line break
+ (account-for-line-break input) )))
+ nil)
+ ,input))
+
+(definline unread-rune (rune input)
+ "Unread the last recently read rune; if there wasn't such a rune, you
+ deserve to lose."
+ (declare (ignore rune))
+ (decf (xstream-read-ptr input))
+ (when (rune= (peek-rune input) #/u+000A) ;was it a line break?
+ (unaccount-for-line-break input)))
+
+(defun fread-rune (input)
+ (read-rune input))
+
+(defun fpeek-rune (input)
+ (peek-rune input))
+
+;;; Line counting
+
+(defun account-for-line-break (input)
+ (declare (type xstream input))
+ (incf (xstream-line-number input))
+ (setf (xstream-line-start input)
+ (+ (xstream-buffer-start input) (xstream-read-ptr input))))
+
+(defun unaccount-for-line-break (input)
+ ;; incomplete!
+ ;; We better use a traditional lookahead technique or forbid unread-rune.
+ (decf (xstream-line-number input)))
+
+;; User API:
+
+(defun xstream-position (input)
+ (+ (xstream-buffer-start input) (xstream-read-ptr input)))
+
+;; xstream-line-number is structure accessor
+
+(defun xstream-column-number (input)
+ (+ (- (xstream-position input)
+ (xstream-line-start input))
+ 1))
+
+;;; Underflow
+
+(defconstant +default-buffer-size+ 100)
+
+(defmethod xstream-underflow ((input xstream))
+ (declare (type xstream input))
+ ;; we are about to fill new data into the buffer, so we need to
+ ;; adjust buffer-start.
+ (incf (xstream-buffer-start input)
+ (- (xstream-fill-ptr input) 0))
+ (let (n m)
+ ;; when there is something left in the os-buffer, we move it to
+ ;; the start of the buffer.
+ (setf m (- (xstream-os-left-end input) (xstream-os-left-start input)))
+ (unless (zerop m)
+ (replace (xstream-os-buffer input) (xstream-os-buffer input)
+ :start1 0 :end1 m
+ :start2 (xstream-os-left-start input)
+ :end2 (xstream-os-left-end input))
+ ;; then we take care that the buffer is large enough to carry at
+ ;; least 100 bytes (a random number)
+ ;;
+ ;; David: My understanding is that any number of octets large enough
+ ;; to record the longest UTF-8 sequence or UTF-16 sequence is okay,
+ ;; so 100 is plenty for this purpose.
+ (unless (>= (length (xstream-os-buffer input))
+ +default-buffer-size+)
+ (error "You lost")))
+ (setf n
+ (read-octets (xstream-os-buffer input) (xstream-os-stream input)
+ m (min (1- (length (xstream-os-buffer input)))
+ (+ m (xstream-speed input)))))
+ (cond ((%= n 0)
+ (setf (xstream-read-ptr input) 0
+ (xstream-fill-ptr input) n)
+ (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+)
+ :eof)
+ (t
+ (multiple-value-bind (fnw fnr)
+ (runes-encoding:decode-sequence
+ (xstream-encoding input)
+ (xstream-os-buffer input) 0 n
+ (xstream-buffer input) 0 (1- (length (xstream-buffer input)))
+ (= n m))
+ (setf (xstream-os-left-start input) fnr
+ (xstream-os-left-end input) n
+ (xstream-read-ptr input) 0
+ (xstream-fill-ptr input) fnw)
+ (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+)
+ (read-rune input))))))
+
+;;; constructor
+
+(defun make-xstream (os-stream &key name
+ (speed 8192)
+ (initial-speed 1)
+ (initial-encoding :guess))
+ ;; XXX if initial-speed isn't 1, encoding will me munged up
+ (assert (eql initial-speed 1))
+ (multiple-value-bind (encoding preread)
+ (if (eq initial-encoding :guess)
+ (figure-encoding os-stream)
+ (values initial-encoding nil))
+ (let* ((bufsize (max speed +default-buffer-size+))
+ (osbuf (make-array bufsize :element-type '(unsigned-byte 8))))
+ (replace osbuf preread)
+ (make-xstream/low
+ :buffer (let ((r (make-array bufsize :element-type 'buffer-byte)))
+ (setf (elt r 0) #xFFFF)
+ r)
+ :read-ptr 0
+ :fill-ptr 0
+ :os-buffer osbuf
+ :speed initial-speed
+ :full-speed speed
+ :os-stream os-stream
+ :os-left-start 0
+ :os-left-end (length preread)
+ :encoding encoding
+ :name name))))
+
+(defun make-rod-xstream (string &key name)
+ (unless (typep string 'simple-array)
+ (setf string (coerce string 'simple-string)))
+ ;; XXX encoding is mis-handled by this kind of stream
+ (let ((n (length string)))
+ (let ((buffer (make-array (1+ n) :element-type 'buffer-byte)))
+ (declare (type (simple-array buffer-byte (*)) buffer))
+ ;; copy the rod
+ (do ((i (1- n) (- i 1)))
+ ((< i 0))
+ (declare (type fixnum i))
+ (setf (aref buffer i) (rune-code (%rune string i))))
+ (setf (aref buffer n) +end+)
+ ;;
+ (make-xstream/low :buffer buffer
+ :read-ptr 0
+ :fil