May 2008 - flexi-streams-cvs@common-lisp.net

[flexi-streams-cvs] r31 - in branches/edi: . doc test
by eweitz＠common-lisp.net 19 May '08

19 May '08

Author: eweitz Date: Mon May 19 04:01:35 2008 New Revision: 31 Modified: branches/edi/conditions.lisp branches/edi/decode.lisp branches/edi/doc/index.html branches/edi/encode.lisp branches/edi/in-memory.lisp branches/edi/input.lisp branches/edi/lw-binary-stream.lisp branches/edi/output.lisp branches/edi/packages.lisp branches/edi/specials.lisp branches/edi/stream.lisp branches/edi/strings.lisp branches/edi/test/test.lisp branches/edi/util.lisp Log: Fix condition hierarchy Passes tests Modified: branches/edi/conditions.lisp ============================================================================== --- branches/edi/conditions.lisp (original) +++ branches/edi/conditions.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.4 2008/05/18 20:34:52 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.5 2008/05/19 07:57:07 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -31,8 +31,8 @@ (define-condition flexi-stream-error (stream-error) () - (:documentation "Superclass for all errors related to -flexi streams.")) + (:documentation "Superclass for all errors related to flexi +streams.")) (define-condition flexi-stream-simple-error (flexi-stream-error simple-condition) () @@ -48,33 +48,16 @@ (:documentation "Errors of this type are signalled if the flexi stream has a wrong element type.")) -(define-condition flexi-stream-encoding-error (flexi-stream-simple-error) - () - (:documentation "Errors of this type are signalled if there is an -encoding problem.")) - -(define-condition flexi-stream-position-spec-error (flexi-stream-simple-error) - ((position-spec :initarg :position-spec - :reader flexi-stream-position-spec-error-position-spec)) - (:documentation "Errors of this type are signalled if an -erroneous position spec is used in conjunction with -FILE-POSITION.")) - -;; TODO: stream might not be a stream... -(defun signal-encoding-error (format-control &rest format-args) - "Convenience function similar to ERROR to signal conditions of type -FLEXI-STREAM-ENCODING-ERROR." - (error 'flexi-stream-encoding-error - :format-control format-control - :format-arguments format-args - #+(or) #+(or) - :stream flexi-stream)) - (define-condition in-memory-stream-error (stream-error) () (:documentation "Superclass for all errors related to IN-MEMORY streams.")) +(define-condition in-memory-stream-simple-error (in-memory-stream-error simple-condition) + () + (:documentation "Like IN-MEMORY-STREAM-ERROR but with formatting +capabilities.")) + (define-condition in-memory-stream-closed-error (in-memory-stream-error) () (:report (lambda (condition stream) @@ -83,3 +66,33 @@ (:documentation "An error that is signalled when someone is trying to read from or write to a closed IN-MEMORY stream.")) +(define-condition in-memory-stream-position-spec-error (in-memory-stream-simple-error) + ((position-spec :initarg :position-spec + :reader in-memory-stream-position-spec-error-position-spec)) + (:documentation "Errors of this type are signalled if an erroneous +position spec is used in conjunction with FILE-POSITION.")) + +(define-condition external-format-error () + ((external-format :initarg :external-format + :initform nil + :reader external-format-error-external-format)) + (:documentation "Superclass for all errors related to external +formats.")) + +(define-condition external-format-simple-error (external-format-error simple-condition) + () + (:documentation "Like EXTERNAL-FORMAT-ERROR but with formatting +capabilities.")) + +(define-condition external-format-encoding-error (external-format-simple-error) + () + (:documentation "Errors of this type are signalled if there is an +encoding problem.")) + +(defun signal-encoding-error (external-format format-control &rest format-args) + "Convenience function similar to ERROR to signal conditions of type +EXTERNAL-FORMAT-ENCODING-ERROR." + (error 'external-format-encoding-error + :format-control format-control + :format-arguments format-args + :external-format external-format)) Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.7 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.9 2008/05/19 07:57:07 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,16 +29,16 @@ (in-package :flexi-streams) -(defun recover-from-encoding-error (format-control &rest format-args) +(defun recover-from-encoding-error (external-format format-control &rest format-args) "Helper function used by OCTETS-TO-CHAR-CODE below to deal with encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and returns -its character code in this case. Otherwise signals a -FLEXI-STREAM-ENCODING-ERROR as determined by the arguments to this +its character code in this case. Otherwise signals an +EXTERNAL-FORMAT-ENCODING-ERROR as determined by the arguments to this function and provides a corresponding USE-VALUE restart." (when *substitution-char* (return-from recover-from-encoding-error (char-code *substitution-char*))) (restart-case - (apply #'signal-encoding-error format-control format-args) + (apply #'signal-encoding-error external-format format-control format-args) (use-value (char) :report "Specify a character to be used instead." :interactive (lambda () @@ -72,7 +72,8 @@ (return-from octets-to-char-code :eof)))) (declare (type octet octet)) (if (> octet 127) - (recover-from-encoding-error "No character which corresponds to octet #x~X." octet) + (recover-from-encoding-error format + "No character which corresponds to octet #x~X." octet) octet))) (defmethod octets-to-char-code ((format flexi-8-bit-format) reader) @@ -86,7 +87,8 @@ (declare (type octet octet)) (if (or (null char-code) (= (the char-code-integer char-code) 65533)) - (recover-from-encoding-error "No character which corresponds to octet #x~X." octet) + (recover-from-encoding-error format + "No character which corresponds to octet #x~X." octet) char-code)))) (defmethod octets-to-char-code ((format flexi-utf-8-format) reader) @@ -99,7 +101,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-8 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-8 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (let ((octet (read-next-byte))) @@ -118,7 +121,8 @@ ((= #b11111100 (logand octet #b11111110)) (values (logand octet #b00000001) 5)) (t (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected value #x~X at start of UTF-8 sequence." + (recover-from-encoding-error format + "Unexpected value #x~X at start of UTF-8 sequence." octet)))) (declare (fixnum count)) ;; note that we currently don't check for "overlong" @@ -130,7 +134,8 @@ for octet of-type octet = (read-next-byte) unless (= #b10000000 (logand octet #b11000000)) do (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected value #x~X in UTF-8 sequence." octet)) + (recover-from-encoding-error format + "Unexpected value #x~X in UTF-8 sequence." octet)) finally (return result))))))) (defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader) @@ -143,7 +148,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-16 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-16 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (flet ((read-next-word () @@ -156,7 +162,8 @@ (declare (type (unsigned-byte 16) next-word)) (unless (<= #xdc00 next-word #xdfff) (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected UTF-16 word #x~X following #x~X." + (recover-from-encoding-error format + "Unexpected UTF-16 word #x~X following #x~X." next-word word))) (+ (ash (logand #b1111111111 word) 10) (logand #b1111111111 next-word) @@ -173,7 +180,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-16 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-16 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (flet ((read-next-word () @@ -186,7 +194,8 @@ (declare (type (unsigned-byte 16) next-word)) (unless (<= #xdc00 next-word #xdfff) (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected UTF-16 word #x~X following #x~X." + (recover-from-encoding-error format + "Unexpected UTF-16 word #x~X following #x~X." next-word word))) (+ (ash (logand #b1111111111 word) 10) (logand #b1111111111 next-word) @@ -203,7 +212,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-32 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-32 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (loop for count of-type fixnum from 0 to 24 by 8 @@ -220,7 +230,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-32 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-32 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (loop for count of-type fixnum from 24 downto 0 by 8 Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Mon May 19 04:01:35 2008 @@ -56,7 +56,6 @@ <ol> <li><a href="#example">Example usage</a> <li><a href="#install">Download and installation</a> - <li><a href="#backward-compatibility">Backward compatibility with version 0.10.3 and before</a> <li><a href="#mail">Support and mailing lists</a> <li><a href="#dictionary">The FLEXI-STREAMS dictionary</a> <ol> @@ -70,6 +69,7 @@ <li><a href="#external-format-equal"><code>external-format-equal</code></a> <li><a href="#*default-eol-style*"><code>*default-eol-style*</code></a> <li><a href="#*default-little-endian*"><code>*default-little-endian*</code></a> + <li><a href="#external-format-encoding-error"><code>external-format-encoding-error</code></a> </ol> <li><a href="#flexi-streams">Flexi streams</a> <ol> @@ -89,11 +89,8 @@ <li><a href="#*substitution-char*"><code>*substitution-char*</code></a> <li><a href="#octet"><code>octet</code></a> <li><a href="#flexi-stream-error"><code>flexi-stream-error</code></a> - <li><a href="#flexi-stream-encoding-error"><code>flexi-stream-encoding-error</code></a> <li><a href="#flexi-stream-element-type-error"><code>flexi-stream-element-type-error</code></a> <li><a href="#flexi-stream-element-type-error-element-type"><code>flexi-stream-element-type-error-element-type</code></a> - <li><a href="#flexi-stream-position-spec-error"><code>flexi-stream-position-spec-error</code></a> - <li><a href="#flexi-stream-position-spec-error-position-spec"><code>flexi-stream-position-spec-error-position-spec</code></a> </ol> <li><a href="#in-memory">In-memory streams</a> <ol> @@ -110,6 +107,8 @@ <li><a href="#with-output-to-sequence"><code>with-output-to-sequence</code></a> <li><a href="#in-memory-stream-error"><code>in-memory-stream-error</code></a> <li><a href="#in-memory-stream-closed-error"><code>in-memory-stream-closed-error</code></a> + <li><a href="#in-memory-stream-position-spec-error"><code>in-memory-stream-position-spec-error</code></a> + <li><a href="#in-memory-stream-position-spec-error-position-spec"><code>in-memory-stream-position-spec-error-position-spec</code></a> </ol> <li><a href="#strings">Strings</a> <ol> @@ -256,27 +255,6 @@ href="http://arcanes.fr.eu.org/~pierre/2007/02/weitz/">http://arcanes.fr.eu.org/~pierre/2007/02/weitz/</a> thanks to Pierre Thierry. - -   -<h3><a name="backward-compatibility" class=none> -Backward compatibility with version 0.10.3 and before</a></h3> - -Two special variables used in flexi-streams 0.10.3 and before were removed - -<code>*PROVIDE-USE-VALUE-RESTART*</code> and <code>*USE-REPLACEMENT-CHAR*</code>. - - -The code now behaves as if -<code>*PROVIDE-USE-VALUE-RESTART*</code> is always <code>T</code>. -Instead of <code>*USE-REPLACEMENT-CHAR*</code>, you can use -<a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> or -invoke -a <a -href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> -restart</a> -when a <a -href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> -is signalled. -   <h3><a name="mail" class=none>Support and mailing lists</a></h3> For questions, bug reports, feature requests, improvements, or patches @@ -542,6 +520,32 @@ The default value for the <code>little-endian</code> keyword argument of <a href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>. Its initial value corresponds to the endianess of the platform FLEXI-STREAMS is used on as revealed by the <code>:LITTLE-ENDIAN</code> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/24_ab.htm">feature</a>. </blockquote> + [Condition] + <a class=none name="external-format-error">external-format-error</a> + +<blockquote> +All errors related to <a href="#external-formats">external formats</a> are of this type. +There's a slot for the external format which can be accessed with <a href="#external-format-error-external-format"><code>EXTERNAL-FORMAT-ERROR-EXTERNAL-FORMAT</code></a>. +</blockquote> + + [Reader] + <a class=none name="external-format-error-external-format">external-format-error-external-format condition => external-format</a> + +<blockquote> If <code>condition</code> is of +type <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>, +this function will return the associated external format. Note that +there are errors which happen during the creation of external formats +where this method returns <code>NIL</code>. +</blockquote> + + [Condition] + <a class=none name="external-format-encoding-error">external-format-encoding-error</a> + +<blockquote> +All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signalled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> +restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and example for it. <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> is a subtype of <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>. +</blockquote> + <h4><a name="flexi-streams" class=none>Flexi streams</a></h4> Flexi streams are the core of the FLEXI-STREAMS library. You @@ -736,7 +740,7 @@ <blockquote> If this value is not NIL, it should be a character which is used (as if by a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> restart</a>) whenever during reading an error of -type <a href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> would have been signalled otherwise. +type <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> would have been signalled otherwise. <pre> CL-USER 1 > (defun foo () @@ -770,7 +774,7 @@ "xy" T -CL-USER 5 > (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#flexi-stream-encoding-error" class=noborder>flexi-stream-encoding-error</a> (lambda (condition) +CL-USER 5 > (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#external-format-encoding-error" class=noborder>external-format-encoding-error</a> (lambda (condition) (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm" class=noborder>use-value</a> #\-)))) (foo)) "--" @@ -798,14 +802,6 @@ </blockquote> [Condition] - <a class=none name="flexi-stream-encoding-error">flexi-stream-encoding-error</a> - -<blockquote> -All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signalled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> -restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and example for it. <a href="#flexi-encodingstream-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> is a subtype of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a>. -</blockquote> - - [Condition] <a class=none name="flexi-stream-element-type-error">flexi-stream-element-type-error</a> <blockquote> @@ -819,26 +815,6 @@ If <code>condition</code> is of type <a href="#flexi-stream-element-type-error"><code>FLEXI-STREAM-ELEMENT-TYPE-ERROR</code></a>, this function will return the offending element type. </blockquote> - [Condition] - <a class=none name="flexi-stream-position-spec-error">flexi-stream-position-spec-error</a> - -<blockquote> Errors of this type are signalled if an erroneous -position spec is used in conjunction -with <a href="#position"><code>FILE-POSITION</code></a>. This is a -subtype -of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a> -and has an additional slot for the position spec which can be accessed -with <a -href="#flexi-stream-position-spec-error-position-spec"><code>FLEXI-STREAM-POSITION-SPEC-ERROR-POSITION-SPEC</code></a>. -</blockquote> - - [Reader] - <a class=none name="flexi-stream-position-spec-error-position-spec">flexi-stream-position-spec-error-position-spec condition => position-spec</a> - -<blockquote> -If <code>condition</code> is of type <a href="#flexi-stream-position-spec-error"><code>FLEXI-STREAM-POSITION-SPEC-ERROR</code></a>, this function will return the offending position spec. -</blockquote> - <h4><a name="in-memory" class=none>In-memory streams</a></h4> The library also provides in-memory binary streams which are modeled after <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_stg_st.htm">string streams</a> and behave very similar only that they deal with <a href="#octet">octets</a> instead of characters and the underlying data structure is not a string but either a list or a vector. These streams can obviously be used as the underlying streams for <a href="#flexi-streams">flexi streams</a>. @@ -965,6 +941,25 @@ An error of this type is signalled if one tries to read from or write to an <a href="#in-memory">in-memory stream</a> which had already been closed. This is a subtype of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a>. </blockquote> + [Condition] + <a class=none name="in-memory-stream-position-spec-error">in-memory-stream-position-spec-error</a> + +<blockquote> Errors of this type are signalled if an erroneous +position spec is used in conjunction +with <a href="#position"><code>FILE-POSITION</code></a>. This is a +subtype +of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a> +and has an additional slot for the position spec which can be accessed +with <a href="#in-memory-stream-position-spec-error-position-spec"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR-POSITION-SPEC</code></a>. +</blockquote> + + [Reader] + <a class=none name="in-memory-stream-position-spec-error-position-spec">in-memory-stream-position-spec-error-position-spec condition => position-spec</a> + +<blockquote> +If <code>condition</code> is of type <a href="#in-memory-stream-position-spec-error"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR</code></a>, this function will return the offending position spec. +</blockquote> + <h4><a name="strings" class=none>Strings</a></h4> This section collects a few convenience functions for strings conversions: @@ -1037,7 +1032,7 @@ numerous patches and additions. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.100 2008/05/18 14:59:02 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.102 2008/05/19 07:57:10 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.7 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.8 2008/05/19 07:57:07 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -45,7 +45,7 @@ (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 255) - (signal-encoding-error "~S (code ~A) is not a LATIN-1 character." char octet)) + (signal-encoding-error format "~S (code ~A) is not a LATIN-1 character." char octet)) (funcall writer octet))) (defmethod char-to-octets ((format flexi-ascii-format) char writer) @@ -53,7 +53,7 @@ (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 127) - (signal-encoding-error "~S (code ~A) is not an ASCII character." char octet)) + (signal-encoding-error format "~S (code ~A) is not an ASCII character." char octet)) (funcall writer octet))) (defmethod char-to-octets ((format flexi-8-bit-format) char writer) @@ -63,7 +63,7 @@ format (let ((octet (gethash (char-code char) encoding-hash))) (unless octet - (signal-encoding-error "~S (code ~A) is not in this encoding." char octet)) + (signal-encoding-error format "~S (code ~A) is not in this encoding." char octet)) (funcall writer octet)))) (defmethod char-to-octets ((format flexi-utf-8-format) char writer) Modified: branches/edi/in-memory.lisp ============================================================================== --- branches/edi/in-memory.lisp (original) +++ branches/edi/in-memory.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.29 2008/05/17 16:35:58 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.31 2008/05/19 07:57:07 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -107,163 +107,194 @@ #+:cmu (defmethod open-stream-p ((stream in-memory-stream)) "Returns a true value if STREAM is open. See ANSI standard." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (in-memory-stream-open-p stream)) #+:cmu (defmethod close ((stream in-memory-stream) &key abort) "Closes the stream STREAM. See ANSI standard." - (declare (ignore abort) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore abort)) (prog1 (in-memory-stream-open-p stream) (setf (in-memory-stream-open-p stream) nil))) (defmethod check-if-open ((stream in-memory-stream)) "Checks if STREAM is open and signals an error otherwise." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (unless (open-stream-p stream) (error 'in-memory-stream-closed-error :stream stream))) (defmethod stream-element-type ((stream in-memory-stream)) "The element type is always OCTET by definition." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) 'octet) (defmethod transform-octet ((stream in-memory-stream) octet) "Applies the transformer of STREAM to octet and returns the result." + (declare #.*standard-optimize-settings*) (funcall (or (in-memory-stream-transformer stream) #'identity) octet)) (defmethod stream-read-byte ((stream list-input-stream)) "Reads one byte by simply popping it off of the top of the list." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (transform-octet stream (or (pop (list-stream-list stream)) - (return-from stream-read-byte :eof)))) + (with-accessors ((list list-stream-list)) + stream + (transform-octet stream (or (pop list) (return-from stream-read-byte :eof))))) (defmethod stream-listen ((stream list-input-stream)) "Checks whether list is not empty." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (list-stream-list stream)) + (with-accessors ((list list-stream-list)) + stream + list)) (defmethod stream-read-sequence ((stream list-input-stream) sequence start end &key) "Repeatedly pops elements from the list until it's empty." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop for index from start below end - while (list-stream-list stream) - do (setf (elt sequence index) - (pop (list-stream-list stream))) - finally (return index))) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((list list-stream-list)) + stream + (loop for index of-type fixnum from start below end + while list + do (setf (elt sequence index) (pop list)) + finally (return index)))) (defmethod stream-read-byte ((stream vector-input-stream)) "Reads one byte and increments INDEX pointer unless we're beyond END pointer." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (let ((index (vector-stream-index stream))) - (cond ((< index (vector-stream-end stream)) - (incf (vector-stream-index stream)) - (transform-octet stream (aref (vector-stream-vector stream) index))) - (t :eof)))) + (with-accessors ((index vector-stream-index) + (end vector-stream-end) + (vector vector-stream-vector)) + stream + (let ((current-index index)) + (declare (fixnum current-index)) + (cond ((< current-index (the fixnum end)) + (incf (the fixnum index)) + (transform-octet stream (aref vector current-index))) + (t :eof))))) (defmethod stream-listen ((stream vector-input-stream)) "Checking whether INDEX is beyond END." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (< (vector-stream-index stream) (vector-stream-end stream))) + (with-accessors ((index vector-stream-index) + (end vector-stream-end)) + stream + (< (the fixnum index) (the fixnum end)))) (defmethod stream-read-sequence ((stream vector-input-stream) sequence start end &key) "Traverses both sequences in parallel until the end of one of them is reached." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop with vector-end of-type (integer 0 #.array-dimension-limit) = (vector-stream-end stream) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (loop with vector-end of-type fixnum = (vector-stream-end stream) with vector = (vector-stream-vector stream) - for index from start below end - for vector-index of-type (integer 0 #.array-dimension-limit) = (vector-stream-index stream) + for index of-type fixnum from start below end + for vector-index of-type fixnum = (vector-stream-index stream) while (< vector-index vector-end) do (setf (elt sequence index) (aref vector vector-index)) - (incf (vector-stream-index stream)) + (incf (the fixnum (vector-stream-index stream))) finally (return index))) (defmethod stream-write-byte ((stream vector-output-stream) byte) "Writes a byte \(octet) by extending the underlying vector." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (vector-push-extend (transform-octet stream byte) - (vector-stream-vector stream))) + (with-accessors ((vector vector-stream-vector)) + stream + (vector-push-extend (transform-octet stream byte) vector))) (defmethod stream-write-sequence ((stream vector-output-stream) sequence start end &key) "Just calls VECTOR-PUSH-EXTEND repeatedly." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop with vector = (vector-stream-vector stream) - for index from start below end - do (vector-push-extend (elt sequence index) vector)) - sequence) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((vector vector-stream-vector)) + stream + (loop for index of-type fixnum from start below end + do (vector-push-extend (elt sequence index) vector)) + sequence)) (defmethod stream-file-position ((stream vector-input-stream)) "Simply returns the index into the underlying vector." - (declare (optimize speed)) - (vector-stream-index stream)) + (declare #.*standard-optimize-settings*) + (with-accessors ((index vector-stream-index)) + stream + index)) (defmethod (setf stream-file-position) (position-spec (stream vector-input-stream)) "Sets the index into the underlying vector if POSITION-SPEC is acceptable." - (declare (optimize speed)) - (setf (vector-stream-index stream) - (case position-spec - (:start 0) - (:end (vector-stream-end stream)) - (otherwise - (unless (integerp position-spec) - (error 'flexi-stream-position-spec-error - :format-control "Unknown file position designator: ~S." - :format-arguments (list position-spec) - :position-spec position-spec)) - (unless (<= 0 position-spec (vector-stream-end stream)) - (error 'flexi-stream-position-spec-error - :format-control "File position designator ~S is out of bounds." - :format-arguments (list position-spec) - :position-spec position-spec)) - position-spec))) - position-spec) - -(defmethod stream-file-position ((stream vector-output-stream)) - "Simply returns the fill pointer of the underlying vector." - (declare (optimize speed)) - (fill-pointer (vector-stream-vector stream))) - -(defmethod (setf stream-file-position) (position-spec (stream vector-output-stream)) - "Sets the fill pointer underlying vector if POSITION-SPEC is -acceptable. Adjusts the vector if necessary." - (declare (optimize speed)) - (let* ((vector (vector-stream-vector stream)) - (total-size (array-total-size vector)) - (new-fill-pointer + (declare #.*standard-optimize-settings*) + (with-accessors ((index vector-stream-index) + (end vector-stream-end)) + stream + (setq index (case position-spec (:start 0) - (:end - (warn "File position designator :END doesn't really make sense for an output stream.") - total-size) + (:end end) (otherwise (unless (integerp position-spec) - (error 'flexi-stream-position-spec-error + (error 'in-memory-stream-position-spec-error :format-control "Unknown file position designator: ~S." :format-arguments (list position-spec) + :stream stream :position-spec position-spec)) - (unless (<= 0 position-spec array-total-size-limit) - (error 'flexi-stream-position-spec-error + (unless (<= 0 position-spec end) + (error 'in-memory-stream-position-spec-error :format-control "File position designator ~S is out of bounds." :format-arguments (list position-spec) + :stream stream :position-spec position-spec)) - position-spec)))) - (when (> new-fill-pointer total-size) - (adjust-array vector new-fill-pointer)) - (setf (fill-pointer vector) new-fill-pointer) + position-spec))) position-spec)) +(defmethod stream-file-position ((stream vector-output-stream)) + "Simply returns the fill pointer of the underlying vector." + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (fill-pointer vector))) + +(defmethod (setf stream-file-position) (position-spec (stream vector-output-stream)) + "Sets the fill pointer underlying vector if POSITION-SPEC is +acceptable. Adjusts the vector if necessary." + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (let* ((total-size (array-total-size vector)) + (new-fill-pointer + (case position-spec + (:start 0) + (:end + (warn "File position designator :END doesn't really make sense for an output stream.") + total-size) + (otherwise + (unless (integerp position-spec) + (error 'in-memory-stream-position-spec-error + :format-control "Unknown file position designator: ~S." + :format-arguments (list position-spec) + :stream stream + :position-spec position-spec)) + (unless (<= 0 position-spec array-total-size-limit) + (error 'in-memory-stream-position-spec-error + :format-control "File position designator ~S is out of bounds." + :format-arguments (list position-spec) + :stream stream + :position-spec position-spec)) + position-spec)))) + (declare (fixnum total-size new-fill-pointer)) + (when (> new-fill-pointer total-size) + (adjust-array vector new-fill-pointer)) + (setf (fill-pointer vector) new-fill-pointer) + position-spec))) + (defmethod make-in-memory-input-stream ((vector vector) &key (start 0) (end (length vector)) transformer) @@ -271,7 +302,7 @@ octets in the subsequence of VECTOR bounded by START and END. Each octet returned will be transformed in turn by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'vector-input-stream :vector vector :index start @@ -285,7 +316,7 @@ octets in the subsequence of LIST bounded by START and END. Each octet returned will be transformed in turn by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'list-input-stream :list (subseq list start end) :transformer transformer)) @@ -293,7 +324,7 @@ (defun make-output-vector (&key (element-type 'octet)) "Creates and returns an array which can be used as the underlying vector for a VECTOR-OUTPUT-STREAM." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-array 0 :adjustable t :fill-pointer 0 :element-type element-type)) @@ -304,7 +335,7 @@ that contains the octes that were actually output. The octets stored will each be transformed by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'vector-output-stream :vector (make-output-vector :element-type element-type) :transformer transformer)) @@ -316,19 +347,23 @@ been output since the last call to GET-OUTPUT-STREAM-SEQUENCE or since the creation of the stream, whichever occurred most recently. If AS-LIST is true the return value is coerced to a list." - (declare (optimize speed)) - (prog1 - (if as-list - (coerce (vector-stream-vector stream) 'list) - (vector-stream-vector stream)) - (setf (vector-stream-vector stream) - (make-output-vector)))) + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (prog1 + (if as-list + (coerce vector 'list) + vector) + (setq vector + (make-output-vector))))) (defmethod output-stream-sequence-length ((stream in-memory-output-stream)) "Returns the current length of the underlying vector of the IN-MEMORY output stream STREAM." (declare (optimize speed)) - (length (the (simple-array * (*)) (vector-stream-vector stream)))) + (with-accessors ((vector vector-stream-vector)) + stream + (length (the (simple-array * (*)) vector)))) (defmacro with-input-from-sequence ((var sequence &key start end transformer) &body body) Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.59 2008/05/18 21:39:40 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.60 2008/05/19 07:57:07 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -148,8 +148,7 @@ (octet-stack flexi-stream-octet-stack) (external-format flexi-stream-external-format)) flexi-input-stream - (let ((*current-stream* flexi-input-stream) - (counter 0) octets-reversed) + (let ((counter 0) octets-reversed) (declare (integer position) (fixnum counter)) (char-to-octets external-format @@ -174,7 +173,6 @@ (setq last-octet nil) (let* ((*current-unreader* (lambda (char) (unread-char% char stream))) - (*current-stream* stream) (char-code (octets-to-char-code external-format (lambda () (read-byte* stream))))) Modified: branches/edi/lw-binary-stream.lisp ============================================================================== --- branches/edi/lw-binary-stream.lisp (original) +++ branches/edi/lw-binary-stream.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.13 2008/05/17 14:21:20 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.14 2008/05/18 23:13:59 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -48,251 +48,11 @@ optimizing input and output on LispWorks. See READ-BYTE* and WRITE-BYTE*.")) -(defclass flexi-binary-8-bit-input-stream (flexi-8-bit-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-8-BIT-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-input-stream (flexi-cr-mixin flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-input-stream (flexi-ascii-input-stream flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-ASCII-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-input-stream (flexi-cr-mixin flexi-binary-ascii-input-stream) - () - (:documentation "Like FLEXI-CR-ASCII-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-input-stream (flexi-latin-1-input-stream flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-LATIN-1-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-input-stream (flexi-cr-mixin flexi-binary-latin-1-input-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-input-stream (flexi-utf-32-le-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-input-stream (flexi-cr-mixin flexi-binary-utf-32-le-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-input-stream (flexi-utf-32-be-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-input-stream (flexi-cr-mixin flexi-binary-utf-32-be-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-input-stream (flexi-utf-16-le-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-input-stream (flexi-cr-mixin flexi-binary-utf-16-le-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-input-stream (flexi-utf-16-be-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-input-stream (flexi-cr-mixin flexi-binary-utf-16-be-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-input-stream (flexi-utf-8-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-8-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-input-stream (flexi-cr-mixin flexi-binary-utf-8-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-8-bit-output-stream (flexi-8-bit-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-8-BIT-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-output-stream (flexi-cr-mixin flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-output-stream (flexi-ascii-output-stream flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-ASCII-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-output-stream (flexi-cr-mixin flexi-binary-ascii-output-stream) - () - (:documentation "Like FLEXI-CR-ASCII-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-output-stream (flexi-latin-1-output-stream flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-LATIN-1-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-output-stream (flexi-cr-mixin flexi-binary-latin-1-output-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-output-stream (flexi-utf-32-le-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-output-stream (flexi-cr-mixin flexi-binary-utf-32-le-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-output-stream (flexi-utf-32-be-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-output-stream (flexi-cr-mixin flexi-binary-utf-32-be-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-output-stream (flexi-utf-16-le-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-output-stream (flexi-cr-mixin flexi-binary-utf-16-le-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-output-stream (flexi-utf-16-be-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-output-stream (flexi-cr-mixin flexi-binary-utf-16-be-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-output-stream (flexi-utf-8-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-8-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-output-stream (flexi-cr-mixin flexi-binary-utf-8-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-8-bit-io-stream (flexi-binary-io-stream flexi-8-bit-io-stream) - () - (:documentation "Like FLEXI-8-BIT-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-io-stream (flexi-cr-mixin flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-io-stream (flexi-ascii-io-stream flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-ASCII-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-io-stream (flexi-cr-mixin flexi-binary-ascii-io-stream) - () - (:documentation "Like FLEXI-CR-ASCII-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-io-stream (flexi-latin-1-io-stream flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-LATIN-1-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-io-stream (flexi-cr-mixin flexi-binary-latin-1-io-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-io-stream (flexi-utf-32-le-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-io-stream (flexi-cr-mixin flexi-binary-utf-32-le-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-io-stream (flexi-utf-32-be-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-io-stream (flexi-cr-mixin flexi-binary-utf-32-be-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-io-stream (flexi-utf-16-le-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-io-stream (flexi-cr-mixin flexi-binary-utf-16-le-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-io-stream (flexi-utf-16-be-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-io-stream (flexi-cr-mixin flexi-binary-utf-16-be-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-io-stream (flexi-utf-8-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-8-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-io-stream (flexi-cr-mixin flexi-binary-utf-8-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-IO-STREAM but -optimized for LispWorks binary streams.")) - (defmethod initialize-instance :after ((flexi-stream flexi-output-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. Only needed for LispWorks." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((stream flexi-stream-stream)) flexi-stream (when (subtypep (stream-element-type stream) 'octet) @@ -304,8 +64,8 @@ (defmethod initialize-instance :after ((flexi-stream flexi-input-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. Only needed for LispWorks." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((stream flexi-stream-stream)) flexi-stream (when (subtypep (stream-element-type stream) 'octet) Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.49 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.50 2008/05/19 07:57:07 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -66,11 +66,10 @@ (declare (optimize speed)) (with-accessors ((external-format flexi-stream-external-format)) stream - (let ((*current-stream* stream)) - (char-to-octets external-format - char - (lambda (octet) - (write-byte* octet stream)))))) + (char-to-octets external-format + char + (lambda (octet) + (write-byte* octet stream))))) (defmethod stream-write-char :after ((stream flexi-output-stream) char) (declare (optimize speed)) @@ -155,7 +154,6 @@ (stream-write-byte flexi-output-stream element)) sequence)))) -#+(or) (defmethod stream-write-sequence ((stream flexi-output-stream) (sequence string) start end &key) "Optimized method for the cases where SEQUENCE is a string. Fills an internal buffer and uses repeated calls to WRITE-SEQUENCE to write @@ -168,15 +166,14 @@ (unless (typep stream 'flexi-binary-output-stream) (return-from stream-write-sequence (call-next-method))) - (let* ((buffer (make-array (+ +buffer-size+ 20) - :element-type '(unsigned-byte 8) - :fill-pointer 0)) - (last-newline-pos (position #\Newline sequence - :test #'char= - :start start - :end end - :from-end t)) - (*current-stream* stream)) + (let ((buffer (make-array (+ +buffer-size+ 20) + :element-type '(unsigned-byte 8) + :fill-pointer 0)) + (last-newline-pos (position #\Newline sequence + :test #'char= + :start start + :end end + :from-end t))) (loop with format = (flexi-stream-external-format stream) for index from start below end do (char-to-octets format Modified: branches/edi/packages.lisp ============================================================================== --- branches/edi/packages.lisp (original) +++ branches/edi/packages.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.32 2008/05/18 21:32:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.33 2008/05/19 07:57:08 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -41,6 +41,9 @@ :*default-little-endian* :*substitution-char* :external-format-eol-style + :external-format-error + :external-format-error-external-format + :external-format-encoding-error :external-format-equal :external-format-id :external-format-little-endian @@ -51,20 +54,19 @@ :flexi-stream :flexi-stream-bound :flexi-stream-external-format - :flexi-stream-encoding-error :flexi-stream-element-type :flexi-stream-element-type-error :flexi-stream-element-type-error-element-type :flexi-stream-error :flexi-stream-column :flexi-stream-position - :flexi-stream-position-spec-error - :flexi-stream-position-spec-error-position-spec :flexi-stream-stream :get-output-stream-sequence :in-memory-stream :in-memory-stream-closed-error :in-memory-stream-error + :in-memory-stream-position-spec-error + :in-memory-stream-position-spec-error-position-spec :in-memory-input-stream :in-memory-output-stream :list-stream Modified: branches/edi/specials.lisp ============================================================================== --- branches/edi/specials.lisp (original) +++ branches/edi/specials.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.30 2008/05/18 21:32:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.31 2008/05/19 07:57:08 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -38,14 +38,6 @@ (compilation-speed 0)) "The standard optimize settings used by most declaration expressions.") -(defvar *current-stream* nil - "The `stream' that is currently read from or written to. Not -necessarily a stream, can be any source or sink, like an array or a -list. Mainly used for error reporting. - -Must be bound to a suitable value when OCTETS-TO-CHAR-CODE or -CHAR-TO-OCTETS are called.") - (defvar *current-unreader* nil "A unary function which might be called to `unread' a character \(i.e. the sequence of octets it represents). Modified: branches/edi/stream.lisp ============================================================================== --- branches/edi/stream.lisp (original) +++ branches/edi/stream.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.59 2008/05/18 01:21:34 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.60 2008/05/18 23:14:00 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -52,8 +52,8 @@ (defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs) "Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain reasonable values." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((external-format flexi-stream-external-format) (element-type flexi-stream-element-type)) flexi-stream @@ -67,10 +67,12 @@ (defmethod (setf flexi-stream-external-format) :around (new-value (flexi-stream flexi-stream)) "Converts the new value to an EXTERNAL-FORMAT object if necessary." + (declare #.*standard-optimize-settings*) (call-next-method (maybe-convert-external-format new-value) flexi-stream)) (defmethod (setf flexi-stream-element-type) :before (new-value (flexi-stream flexi-stream)) "Checks whether the new value makes sense before it is set." + (declare #.*standard-optimize-settings*) (unless (or (subtypep new-value 'character) (subtypep new-value 'octet)) (error 'flexi-stream-element-type-error @@ -80,13 +82,15 @@ (defmethod stream-element-type ((stream flexi-stream)) "Returns the element type that was provided by the creator of the stream." - (declare (optimize speed)) - (flexi-stream-element-type stream)) + (declare #.*standard-optimize-settings*) + (with-accessors ((element-type flexi-stream-element-type)) + stream + element-type)) (defmethod close ((stream flexi-stream) &key abort) "Closes the flexi stream by closing the underlying `real' stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) stream (cond ((open-stream-p stream) @@ -95,19 +99,24 @@ (defmethod open-stream-p ((stream flexi-stream)) "A flexi stream is open if its underlying stream is open." - (declare (optimize speed)) - (open-stream-p (flexi-stream-stream stream))) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (open-stream-p stream))) (defmethod stream-file-position ((stream flexi-stream)) "Dispatch to method for underlying stream." - (declare (optimize speed)) - (stream-file-position (flexi-stream-stream stream))) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (stream-file-position stream))) (defmethod (setf stream-file-position) (position-spec (stream flexi-stream)) "Dispatch to method for underlying stream." - (declare (optimize speed)) - (setf (stream-file-position (flexi-stream-stream stream)) - position-spec)) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (setf (stream-file-position stream) position-spec))) (defclass flexi-output-stream (flexi-stream fundamental-binary-output-stream fundamental-character-output-stream) @@ -123,7 +132,7 @@ #+:cmu (defmethod input-stream-p ((stream flexi-output-stream)) "Explicitly states whether this is an input stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) nil) (defclass flexi-input-stream (flexi-stream fundamental-binary-input-stream @@ -166,7 +175,7 @@ #+:cmu (defmethod output-stream-p ((stream flexi-input-stream)) "Explicitly states whether this is an output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) nil) (defclass flexi-io-stream (flexi-input-stream flexi-output-stream) @@ -179,13 +188,13 @@ #+:cmu (defmethod input-stream-p ((stream flexi-io-stream)) "Explicitly states whether this is an input stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) t) #+:cmu (defmethod output-stream-p ((stream flexi-io-stream)) "Explicitly states whether this is an output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) t) (defun make-flexi-stream (stream &rest args @@ -207,6 +216,7 @@ streams) should be NIL or an integer. If BOUND is not NIL and POSITION has gone beyond BOUND, then the stream will behave as if no more input is available." + (declare #.*standard-optimize-settings*) ;; these arguments are ignored - they are only there to provide a ;; meaningful parameter list for IDEs (declare (ignore element-type column position bound)) Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.12 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.14 2008/05/19 07:57:08 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -38,8 +38,7 @@ (declare (fixnum start end) (string string)) (setq external-format (maybe-convert-external-format external-format)) (let ((factor (encoding-factor external-format)) - (length (- end start)) - (*current-stream* string)) + (length (- end start))) (etypecase factor (float (let ((octets (make-array (round (* factor length)) @@ -47,6 +46,7 @@ :fill-pointer 0 :adjustable t))) (flet ((writer (octet) + ;; TODO: do this manually (vector-push-extend octet octets))) (loop for i of-type fixnum from start below end do (char-to-octets external-format @@ -102,13 +102,11 @@ (prog1 (nth i sequence) (incf i)))))) - (*current-stream* sequence) - (*current-unreader* (lambda (char) - (char-to-octets external-format - char - (lambda (octet) - (declare (ignore octet)) - (decf i)))))) + (*current-unreader* (flet ((pseudo-writer (octet) + (declare (ignore octet)) + (decf i))) + (lambda (char) + (char-to-octets external-format char #'pseudo-writer))))) (declare (fixnum i)) (flet ((next-char () (code-char (octets-to-char-code external-format reader)))) @@ -119,6 +117,7 @@ :fill-pointer 0 :adjustable t))) (loop while (< i end) + ;; TODO: do this manually do (vector-push-extend (next-char) string) finally (return string)))) (integer Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.22 2008/05/18 14:59:04 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.25 2008/05/19 07:57:12 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -256,11 +256,40 @@ (terpri *error-output*)) ,successp)))) +(defun old-string-to-octets (string &key + (external-format (make-external-format :latin1)) + (start 0) end) + "The old version of STRING-TO-OCTETS. We can use it to test +in-memory streams." + (declare (optimize speed)) + (with-output-to-sequence (out) + (let ((flexi (make-flexi-stream out :external-format external-format))) + (write-string string flexi :start start :end end)))) + +(defun old-octets-to-string (vector &key + (external-format (make-external-format :latin1)) + (start 0) (end (length vector))) + "The old version of OCTETS-TO-STRING. We can use it to test +in-memory streams." + (declare (optimize speed)) + (with-input-from-sequence (in vector :start start :end end) + (let ((flexi (make-flexi-stream in :external-format external-format)) + (result (make-array (- end start) + :element-type #+:lispworks 'lw:simple-char + #-:lispworks 'character + :fill-pointer t))) + (setf (fill-pointer result) + (read-sequence result flexi)) + result))) + (defun string-test (pathspec external-format) "Tests whether conversion from strings to octets and vice versa using the external format EXTERNAL-FORMAT works as expected, using the contents of the file denoted by PATHSPEC as test data and assuming -that the stream conversion functions work." +that the stream conversion functions work. + +Also tests with the old versions of the conversion functions in order +to test in-memory streams." (let* ((full-path (merge-pathnames pathspec *this-file*)) (octets-vector (file-as-octet-vector full-path)) (octets-list (coerce octets-vector 'list)) @@ -269,27 +298,30 @@ (flex::normalize-external-format external-format))) (check (string= (octets-to-string octets-vector :external-format external-format) string)) (check (string= (octets-to-string octets-list :external-format external-format) string)) - (check (equalp (string-to-octets string :external-format external-format) octets-vector))))) + (check (equalp (string-to-octets string :external-format external-format) octets-vector)) + (check (string= (old-octets-to-string octets-vector :external-format external-format) string)) + (check (string= (old-octets-to-string octets-list :external-format external-format) string)) + (check (equalp (old-string-to-octets string :external-format external-format) octets-vector))))) (defmacro using-values ((&rest values) &body body) "Executes BODY and feeds an element from VALUES to the USE-VALUE -restart each time a FLEXI-STREAM-ENCODING-ERROR is signalled. Signals -an error when there are more or less FLEXI-STREAM-ENCODING-ERRORs than -there are elements in VALUES." +restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled. +Signals an error when there are more or less +EXTERNAL-FORMAT-ENCODING-ERRORs than there are elements in VALUES." (flex::with-unique-names (value-stack condition-counter) `(let ((,value-stack ',values) (,condition-counter 0)) - (handler-bind ((flexi-stream-encoding-error + (handler-bind ((external-format-encoding-error #'(lambda (c) (declare (ignore c)) (unless ,value-stack - (error "Too many FLEXI-STREAM-ENCODING-ERRORs signalled, expected only ~A." + (error "Too many encoding errors signalled, expected only ~A." ,(length values))) (incf ,condition-counter) (use-value (pop ,value-stack))))) (prog1 (progn ,@body) (when ,value-stack - (error "~A FLEXI-STREAM-ENCODING-ERRORs signalled, but ~A were expected." + (error "~A encoding errors signalled, but ~A were expected." ,condition-counter ,(length values)))))))) (defun read-flexi-line (sequence external-format) @@ -299,9 +331,9 @@ (setq in (make-flexi-stream in :external-format external-format)) (read-line in))) -(defun encoding-error-handling-test () - "Tests several possible encoding errors and how they are handled." - (with-test ("Handling of encoding errors.") +(defun error-handling-test () + "Tests several possible errors and how they are handled." + (with-test ("Handling of errors.") ;; handling of EOF in the middle of CRLF (check (string= #.(string #\Return) (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf)))) @@ -382,7 +414,7 @@ (dolist (args string-test-args-list) (apply 'string-test args))) (incf no-tests) - (encoding-error-handling-test) + (error-handling-test) (incf no-tests) (unread-char-test) (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%" Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.16 2008/05/18 20:34:53 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.17 2008/05/19 07:57:08 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -108,8 +108,9 @@ (unless (find real-name +name-map+ :test #'eq :key #'cdr) - ;; TODO... - (error "~S is not known to be a name for an external format." name)) + (error 'external-format-error + :format-control "~S is not known to be a name for an external format." + :format-arguments (list name))) real-name)) (defun ascii-name-p (name)

1 0

[flexi-streams-cvs] r30 - branches/edi
by eweitz＠common-lisp.net 18 May '08

18 May '08

Author: eweitz Date: Sun May 18 18:27:36 2008 New Revision: 30 Added: branches/edi/mapping.lisp (contents, props changed) Modified: branches/edi/ascii.lisp branches/edi/code-pages.lisp branches/edi/conditions.lisp branches/edi/decode.lisp branches/edi/encode.lisp branches/edi/external-format.lisp branches/edi/flexi-streams.asd branches/edi/input.lisp branches/edi/iso-8859.lisp branches/edi/koi8-r.lisp branches/edi/output.lisp branches/edi/packages.lisp branches/edi/specials.lisp branches/edi/strings.lisp branches/edi/util.lisp Log: More optimizations Passes tests Modified: branches/edi/ascii.lisp ============================================================================== --- branches/edi/ascii.lisp (original) +++ branches/edi/ascii.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/ascii.lisp,v 1.8 2008/05/17 13:50:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/ascii.lisp,v 1.9 2008/05/18 21:32:15 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,7 +29,8 @@ (in-package :flexi-streams) -(defvar +ascii-table+ - #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533) +(defconstant +ascii-table+ + ;; currently not used, but we leave it in here just in case... + (make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533)) "An array enumerating the character codes for the US-ASCII encoding.") Modified: branches/edi/code-pages.lisp ============================================================================== --- branches/edi/code-pages.lisp (original) +++ branches/edi/code-pages.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/code-pages.lisp,v 1.6 2008/05/17 13:50:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/code-pages.lisp,v 1.7 2008/05/18 21:32:15 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -31,32 +31,32 @@ ;;; the following code was auto-generated with LWW -(defvar +code-page-tables+ - '((437 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (720 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 233 226 132 224 134 231 234 235 232 239 238 141 142 143 144 1617 1618 244 164 1600 251 249 1569 1570 1571 1572 163 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1590 1591 1592 1593 1594 1601 181 1602 1603 1604 1605 1606 1607 1608 1609 1610 8801 1611 1612 1613 1614 1615 1616 8776 176 8729 183 8730 8319 178 9632 160)) - (737 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 931 932 933 934 935 936 937 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 965 966 967 968 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 969 940 941 942 970 943 972 973 971 974 902 904 905 906 908 910 911 177 8805 8804 938 939 247 8776 176 8729 183 8730 8319 178 9632 160)) - (775 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 262 252 233 257 228 291 229 263 322 275 342 343 299 377 196 197 201 230 198 333 246 290 162 346 347 214 220 248 163 216 215 164 256 298 243 379 380 378 8221 166 169 174 172 189 188 321 171 187 9617 9618 9619 9474 9508 260 268 280 278 9571 9553 9559 9565 302 352 9488 9492 9524 9516 9500 9472 9532 370 362 9562 9556 9577 9574 9568 9552 9580 381 261 269 281 279 303 353 371 363 382 9496 9484 9608 9604 9612 9616 9600 211 223 332 323 245 213 181 324 310 311 315 316 326 274 325 8217 173 177 8220 190 182 167 247 8222 176 8729 183 185 179 178 9632 160)) - (850 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 215 402 225 237 243 250 241 209 170 186 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 240 208 202 203 200 305 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 254 222 218 219 217 253 221 175 180 173 177 8215 190 182 167 247 184 176 168 183 185 179 178 9632 160)) - (852 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 367 263 231 322 235 336 337 238 377 196 262 201 313 314 244 246 317 318 346 347 214 220 356 357 321 215 269 225 237 243 250 260 261 381 382 280 281 172 378 268 351 171 187 9617 9618 9619 9474 9508 193 194 282 350 9571 9553 9559 9565 379 380 9488 9492 9524 9516 9500 9472 9532 258 259 9562 9556 9577 9574 9568 9552 9580 164 273 272 270 203 271 327 205 206 283 9496 9484 9608 9604 354 366 9600 211 223 212 323 324 328 352 353 340 218 341 368 253 221 355 180 173 733 731 711 728 167 247 184 176 168 729 369 344 345 9632 160)) - (855 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1106 1026 1107 1027 1105 1025 1108 1028 1109 1029 1110 1030 1111 1031 1112 1032 1113 1033 1114 1034 1115 1035 1116 1036 1118 1038 1119 1039 1102 1070 1098 1066 1072 1040 1073 1041 1094 1062 1076 1044 1077 1045 1092 1060 1075 1043 171 187 9617 9618 9619 9474 9508 1093 1061 1080 1048 9571 9553 9559 9565 1081 1049 9488 9492 9524 9516 9500 9472 9532 1082 1050 9562 9556 9577 9574 9568 9552 9580 164 1083 1051 1084 1052 1085 1053 1086 1054 1087 9496 9484 9608 9604 1055 1103 9600 1071 1088 1056 1089 1057 1090 1058 1091 1059 1078 1046 1074 1042 1100 1068 8470 173 1099 1067 1079 1047 1096 1064 1101 1069 1097 1065 1095 1063 167 9632 160)) - (857 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 305 196 197 201 230 198 244 246 242 251 249 304 214 220 248 163 216 350 351 225 237 243 250 241 209 286 287 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 186 170 202 203 200 65533 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 65533 215 218 219 217 236 255 175 180 173 177 65533 190 182 167 247 184 176 168 183 185 179 178 9632 160)) - (860 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 227 224 193 231 234 202 232 205 212 236 195 194 201 192 200 244 245 242 218 249 204 213 220 162 163 217 8359 211 225 237 243 250 241 209 170 186 191 210 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (861 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 208 240 222 196 197 201 230 198 244 246 254 251 221 253 214 220 248 163 216 8359 402 225 237 243 250 193 205 211 218 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (862 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (863 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 194 224 182 231 234 235 232 239 238 8215 192 167 201 200 202 244 203 207 251 249 164 212 220 162 163 217 219 402 166 180 243 250 168 184 179 175 206 8976 172 189 188 190 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (864 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 176 183 8729 8730 9618 9472 9474 9532 9508 9516 9500 9524 9488 9484 9492 9496 946 8734 966 177 189 188 8776 171 187 65271 65272 155 156 65275 65276 159 160 173 65154 163 164 65156 65533 65533 65166 65167 65173 65177 1548 65181 65185 65189 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 65233 1563 65201 65205 65209 1567 162 65152 65153 65155 65157 65226 65163 65165 65169 65171 65175 65179 65183 65187 65191 65193 65195 65197 65199 65203 65207 65211 65215 65217 65221 65227 65231 166 172 247 215 65225 1600 65235 65239 65243 65247 65251 65255 65259 65261 65263 65267 65213 65228 65230 65229 65249 65149 1617 65253 65257 65260 65264 65266 65232 65237 65269 65270 65245 65241 65265 9632 65533)) - (865 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 164 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (866 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1025 1105 1028 1108 1031 1111 1038 1118 176 8729 183 8730 8470 164 9632 160)) - (869 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 902 135 183 172 166 8216 8217 904 8213 905 906 938 908 147 148 910 939 169 911 178 179 940 163 941 942 943 970 912 972 973 913 914 915 916 917 918 919 189 920 921 171 187 9617 9618 9619 9474 9508 922 923 924 925 9571 9553 9559 9565 926 927 9488 9492 9524 9516 9500 9472 9532 928 929 9562 9556 9577 9574 9568 9552 9580 931 932 933 934 935 936 937 945 946 947 9496 9484 9608 9604 948 949 9600 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 900 173 177 965 966 967 167 968 901 176 168 969 971 944 974 9632 160)) - (1250 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 352 8249 346 356 381 377 144 8216 8217 8220 8221 8226 8211 8212 152 8482 353 8250 347 357 382 378 160 711 728 321 164 260 166 167 168 169 350 171 172 173 174 379 176 177 731 322 180 181 182 183 184 261 351 187 317 733 318 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729)) - (1251 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1026 1027 8218 1107 8222 8230 8224 8225 8364 8240 1033 8249 1034 1036 1035 1039 1106 8216 8217 8220 8221 8226 8211 8212 152 8482 1113 8250 1114 1116 1115 1119 160 1038 1118 1032 164 1168 166 167 1025 169 1028 171 172 173 174 1031 176 177 1030 1110 1169 181 182 183 1105 8470 1108 187 1112 1029 1109 1111 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103)) - (1252 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 381 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 382 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)) - (1253 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 136 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 157 158 159 160 901 902 163 164 165 166 167 168 169 65533 171 172 173 174 8213 176 177 178 179 900 181 182 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533)) - (1254 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255)) - (1255 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 156 157 158 159 160 161 162 163 8362 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 191 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1520 1521 1522 1523 1524 65533 65533 65533 65533 65533 65533 65533 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533)) - (1256 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 1662 8218 402 8222 8230 8224 8225 710 8240 1657 8249 338 1670 1688 1672 1711 8216 8217 8220 8221 8226 8211 8212 1705 8482 1681 8250 339 8204 8205 1722 160 1548 162 163 164 165 166 167 168 169 1726 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 1563 187 188 189 190 1567 1729 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 215 1591 1592 1593 1594 1600 1601 1602 1603 224 1604 226 1605 1606 1607 1608 231 232 233 234 235 1609 1610 238 239 1611 1612 1613 1614 244 1615 1616 247 1617 249 1618 251 252 8206 8207 1746)) - (1257 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 138 8249 140 168 711 184 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 175 731 159 160 65533 162 163 164 65533 166 167 216 169 342 171 172 173 174 198 176 177 178 179 180 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 729)) - (1258 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 258 196 197 198 199 200 201 202 203 768 205 206 207 272 209 777 211 212 416 214 215 216 217 218 219 220 431 771 223 224 225 226 259 228 229 230 231 232 233 234 235 769 237 238 239 273 241 803 243 244 417 246 247 248 249 250 251 252 432 8363 255))) +(defconstant +code-page-tables+ + `((437 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (720 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 233 226 132 224 134 231 234 235 232 239 238 141 142 143 144 1617 1618 244 164 1600 251 249 1569 1570 1571 1572 163 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1590 1591 1592 1593 1594 1601 181 1602 1603 1604 1605 1606 1607 1608 1609 1610 8801 1611 1612 1613 1614 1615 1616 8776 176 8729 183 8730 8319 178 9632 160))) + (737 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 931 932 933 934 935 936 937 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 965 966 967 968 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 969 940 941 942 970 943 972 973 971 974 902 904 905 906 908 910 911 177 8805 8804 938 939 247 8776 176 8729 183 8730 8319 178 9632 160))) + (775 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 262 252 233 257 228 291 229 263 322 275 342 343 299 377 196 197 201 230 198 333 246 290 162 346 347 214 220 248 163 216 215 164 256 298 243 379 380 378 8221 166 169 174 172 189 188 321 171 187 9617 9618 9619 9474 9508 260 268 280 278 9571 9553 9559 9565 302 352 9488 9492 9524 9516 9500 9472 9532 370 362 9562 9556 9577 9574 9568 9552 9580 381 261 269 281 279 303 353 371 363 382 9496 9484 9608 9604 9612 9616 9600 211 223 332 323 245 213 181 324 310 311 315 316 326 274 325 8217 173 177 8220 190 182 167 247 8222 176 8729 183 185 179 178 9632 160))) + (850 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 215 402 225 237 243 250 241 209 170 186 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 240 208 202 203 200 305 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 254 222 218 219 217 253 221 175 180 173 177 8215 190 182 167 247 184 176 168 183 185 179 178 9632 160))) + (852 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 367 263 231 322 235 336 337 238 377 196 262 201 313 314 244 246 317 318 346 347 214 220 356 357 321 215 269 225 237 243 250 260 261 381 382 280 281 172 378 268 351 171 187 9617 9618 9619 9474 9508 193 194 282 350 9571 9553 9559 9565 379 380 9488 9492 9524 9516 9500 9472 9532 258 259 9562 9556 9577 9574 9568 9552 9580 164 273 272 270 203 271 327 205 206 283 9496 9484 9608 9604 354 366 9600 211 223 212 323 324 328 352 353 340 218 341 368 253 221 355 180 173 733 731 711 728 167 247 184 176 168 729 369 344 345 9632 160))) + (855 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1106 1026 1107 1027 1105 1025 1108 1028 1109 1029 1110 1030 1111 1031 1112 1032 1113 1033 1114 1034 1115 1035 1116 1036 1118 1038 1119 1039 1102 1070 1098 1066 1072 1040 1073 1041 1094 1062 1076 1044 1077 1045 1092 1060 1075 1043 171 187 9617 9618 9619 9474 9508 1093 1061 1080 1048 9571 9553 9559 9565 1081 1049 9488 9492 9524 9516 9500 9472 9532 1082 1050 9562 9556 9577 9574 9568 9552 9580 164 1083 1051 1084 1052 1085 1053 1086 1054 1087 9496 9484 9608 9604 1055 1103 9600 1071 1088 1056 1089 1057 1090 1058 1091 1059 1078 1046 1074 1042 1100 1068 8470 173 1099 1067 1079 1047 1096 1064 1101 1069 1097 1065 1095 1063 167 9632 160))) + (857 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 305 196 197 201 230 198 244 246 242 251 249 304 214 220 248 163 216 350 351 225 237 243 250 241 209 286 287 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 186 170 202 203 200 65533 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 65533 215 218 219 217 236 255 175 180 173 177 65533 190 182 167 247 184 176 168 183 185 179 178 9632 160))) + (860 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 227 224 193 231 234 202 232 205 212 236 195 194 201 192 200 244 245 242 218 249 204 213 220 162 163 217 8359 211 225 237 243 250 241 209 170 186 191 210 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (861 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 208 240 222 196 197 201 230 198 244 246 254 251 221 253 214 220 248 163 216 8359 402 225 237 243 250 193 205 211 218 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (862 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (863 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 194 224 182 231 234 235 232 239 238 8215 192 167 201 200 202 244 203 207 251 249 164 212 220 162 163 217 219 402 166 180 243 250 168 184 179 175 206 8976 172 189 188 190 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (864 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 176 183 8729 8730 9618 9472 9474 9532 9508 9516 9500 9524 9488 9484 9492 9496 946 8734 966 177 189 188 8776 171 187 65271 65272 155 156 65275 65276 159 160 173 65154 163 164 65156 65533 65533 65166 65167 65173 65177 1548 65181 65185 65189 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 65233 1563 65201 65205 65209 1567 162 65152 65153 65155 65157 65226 65163 65165 65169 65171 65175 65179 65183 65187 65191 65193 65195 65197 65199 65203 65207 65211 65215 65217 65221 65227 65231 166 172 247 215 65225 1600 65235 65239 65243 65247 65251 65255 65259 65261 65263 65267 65213 65228 65230 65229 65249 65149 1617 65253 65257 65260 65264 65266 65232 65237 65269 65270 65245 65241 65265 9632 65533))) + (865 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 164 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (866 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1025 1105 1028 1108 1031 1111 1038 1118 176 8729 183 8730 8470 164 9632 160))) + (869 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 902 135 183 172 166 8216 8217 904 8213 905 906 938 908 147 148 910 939 169 911 178 179 940 163 941 942 943 970 912 972 973 913 914 915 916 917 918 919 189 920 921 171 187 9617 9618 9619 9474 9508 922 923 924 925 9571 9553 9559 9565 926 927 9488 9492 9524 9516 9500 9472 9532 928 929 9562 9556 9577 9574 9568 9552 9580 931 932 933 934 935 936 937 945 946 947 9496 9484 9608 9604 948 949 9600 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 900 173 177 965 966 967 167 968 901 176 168 969 971 944 974 9632 160))) + (1250 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 352 8249 346 356 381 377 144 8216 8217 8220 8221 8226 8211 8212 152 8482 353 8250 347 357 382 378 160 711 728 321 164 260 166 167 168 169 350 171 172 173 174 379 176 177 731 322 180 181 182 183 184 261 351 187 317 733 318 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729))) + (1251 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1026 1027 8218 1107 8222 8230 8224 8225 8364 8240 1033 8249 1034 1036 1035 1039 1106 8216 8217 8220 8221 8226 8211 8212 152 8482 1113 8250 1114 1116 1115 1119 160 1038 1118 1032 164 1168 166 167 1025 169 1028 171 172 173 174 1031 176 177 1030 1110 1169 181 182 183 1105 8470 1108 187 1112 1029 1109 1111 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103))) + (1252 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 381 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 382 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))) + (1253 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 136 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 157 158 159 160 901 902 163 164 165 166 167 168 169 65533 171 172 173 174 8213 176 177 178 179 900 181 182 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533))) + (1254 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255))) + (1255 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 156 157 158 159 160 161 162 163 8362 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 191 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1520 1521 1522 1523 1524 65533 65533 65533 65533 65533 65533 65533 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533))) + (1256 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 1662 8218 402 8222 8230 8224 8225 710 8240 1657 8249 338 1670 1688 1672 1711 8216 8217 8220 8221 8226 8211 8212 1705 8482 1681 8250 339 8204 8205 1722 160 1548 162 163 164 165 166 167 168 169 1726 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 1563 187 188 189 190 1567 1729 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 215 1591 1592 1593 1594 1600 1601 1602 1603 224 1604 226 1605 1606 1607 1608 231 232 233 234 235 1609 1610 238 239 1611 1612 1613 1614 244 1615 1616 247 1617 249 1618 251 252 8206 8207 1746))) + (1257 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 138 8249 140 168 711 184 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 175 731 159 160 65533 162 163 164 65533 166 167 216 169 342 171 172 173 174 198 176 177 178 179 180 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 729))) + (1258 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 258 196 197 198 199 200 201 202 203 768 205 206 207 272 209 777 211 212 416 214 215 216 217 218 219 220 431 771 223 224 225 226 259 228 229 230 231 232 233 234 235 769 237 238 239 273 241 803 243 244 417 246 247 248 249 250 251 252 432 8363 255)))) "A list of 8-bit Windows code pages where each element is a cons with the car being the ID of the code page and the cdr being a vector enumerating the corresponding character codes.") Modified: branches/edi/conditions.lisp ============================================================================== --- branches/edi/conditions.lisp (original) +++ branches/edi/conditions.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.3 2008/05/17 15:56:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.4 2008/05/18 20:34:52 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -61,12 +61,13 @@ FILE-POSITION.")) ;; TODO: stream might not be a stream... -(defun signal-encoding-error (flexi-stream format-control &rest format-args) +(defun signal-encoding-error (format-control &rest format-args) "Convenience function similar to ERROR to signal conditions of type FLEXI-STREAM-ENCODING-ERROR." (error 'flexi-stream-encoding-error :format-control format-control :format-arguments format-args + #+(or) #+(or) :stream flexi-stream)) (define-condition in-memory-stream-error (stream-error) Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.4 2008/05/18 00:35:33 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.7 2008/05/18 22:22:30 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,16 +29,16 @@ (in-package :flexi-streams) -(defun recover-from-encoding-error (stream format-control &rest format-args) - "Helper function used by the STREAM-READ-CHAR methods below to deal -with encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and -returns its character code in this case. Otherwise signals a +(defun recover-from-encoding-error (format-control &rest format-args) + "Helper function used by OCTETS-TO-CHAR-CODE below to deal with +encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and returns +its character code in this case. Otherwise signals a FLEXI-STREAM-ENCODING-ERROR as determined by the arguments to this function and provides a corresponding USE-VALUE restart." (when *substitution-char* (return-from recover-from-encoding-error (char-code *substitution-char*))) (restart-case - (apply #'signal-encoding-error stream format-control format-args) + (apply #'signal-encoding-error format-control format-args) (use-value (char) :report "Specify a character to be used instead." :interactive (lambda () @@ -49,45 +49,59 @@ (return (list (char line 0))))))) (char-code char)))) -(defmethod octets-to-char-code ((format flexi-latin-1-format) reader unreader stream) - (declare (ignore unreader stream)) +(defgeneric octets-to-char-code (format reader) + (declare #.*standard-optimize-settings*) + (:documentation "Converts a sequence of octets to a character code +\(which is returned) using the external format FORMAT. The sequence +is obtained by calling the function \(which must be a functional +object) READER with no arguments which should return one octet per +call. + +The special variables *CURRENT-STREAM* and *CURRENT-UNREADER* must be +bound correctly whenever this function is called.")) + +(defmethod octets-to-char-code ((format flexi-latin-1-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (or (funcall reader) :eof)) -(defmethod octets-to-char-code ((format flexi-ascii-format) reader unreader stream) - (declare (ignore unreader)) +(defmethod octets-to-char-code ((format flexi-ascii-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (let ((octet (or (funcall reader) (return-from octets-to-char-code :eof)))) (declare (type octet octet)) (if (> octet 127) - (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) + (recover-from-encoding-error "No character which corresponds to octet #x~X." octet) octet))) -(defmethod octets-to-char-code ((format flexi-8-bit-format) reader unreader stream) - (declare (ignore unreader)) +(defmethod octets-to-char-code ((format flexi-8-bit-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (with-accessors ((decoding-table external-format-decoding-table)) format (let* ((octet (or (funcall reader) (return-from octets-to-char-code :eof))) - (char-code (aref (the (simple-array * *) decoding-table) octet))) + (char-code (aref (the (simple-array char-code-integer *) decoding-table) octet))) (declare (type octet octet)) (if (or (null char-code) - (= char-code 65533)) - (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) + (= (the char-code-integer char-code) 65533)) + (recover-from-encoding-error "No character which corresponds to octet #x~X." octet) char-code)))) -(defmethod octets-to-char-code ((format flexi-utf-8-format) reader unreader stream) - (declare (ignore unreader)) +(defmethod octets-to-char-code ((format flexi-utf-8-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (funcall reader) - (cond (first-octet-seen - (return-from octets-to-char-code - (recover-from-encoding-error stream - "End of file while in UTF-8 sequence."))) - (t (return-from octets-to-char-code :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error "End of file while in UTF-8 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) (let ((octet (read-next-byte))) (declare (type octet octet)) (multiple-value-bind (start count) @@ -104,121 +118,126 @@ ((= #b11111100 (logand octet #b11111110)) (values (logand octet #b00000001) 5)) (t (return-from octets-to-char-code - (recover-from-encoding-error stream - "Unexpected value #x~X at start of UTF-8 sequence." + (recover-from-encoding-error "Unexpected value #x~X at start of UTF-8 sequence." octet)))) + (declare (fixnum count)) ;; note that we currently don't check for "overlong" ;; sequences or other illegal values (loop for result of-type (unsigned-byte 32) - = start then (+ (ash result 6) + = start then (+ (ash (the (unsigned-byte 26) result) 6) (logand octet #b111111)) repeat count for octet of-type octet = (read-next-byte) unless (= #b10000000 (logand octet #b11000000)) do (return-from octets-to-char-code - (recover-from-encoding-error stream - "Unexpected value #x~X in UTF-8 sequence." octet)) + (recover-from-encoding-error "Unexpected value #x~X in UTF-8 sequence." octet)) finally (return result))))))) -(defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader unreader stream) - (declare (ignore unreader)) +(defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (let (first-octet-seen) - (labels ((read-next-byte () - (prog1 - (or (funcall reader) - (cond (first-octet-seen - (return-from octets-to-char-code - (recover-from-encoding-error stream - "End of file while in UTF-16 sequence."))) - (t (return-from octets-to-char-code :eof)))) - (setq first-octet-seen t))) - (read-next-word () + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error "End of file while in UTF-16 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) + (flet ((read-next-word () (+ (the octet (read-next-byte)) (ash (the octet (read-next-byte)) 8)))) - (declare (inline read-next-byte read-next-word) - (dynamic-extent (function read-next-byte) (function read-next-word))) - (let ((word (read-next-word))) - (cond ((<= #xd800 word #xdfff) - (let ((next-word (read-next-word))) - (unless (<= #xdc00 next-word #xdfff) - (return-from octets-to-char-code - (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." - next-word word))) - (+ (ash (logand #b1111111111 word) 10) - (logand #b1111111111 next-word) - #x10000))) - (t word)))))) - -(defmethod octets-to-char-code ((format flexi-utf-16-be-format) reader unreader stream) - (declare (ignore unreader)) + (let ((word (read-next-word))) + (declare (type (unsigned-byte 16) word)) + (cond ((<= #xd800 word #xdfff) + (let ((next-word (read-next-word))) + (declare (type (unsigned-byte 16) next-word)) + (unless (<= #xdc00 next-word #xdfff) + (return-from octets-to-char-code + (recover-from-encoding-error "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) + (+ (ash (logand #b1111111111 word) 10) + (logand #b1111111111 next-word) + #x10000))) + (t word))))))) + +(defmethod octets-to-char-code ((format flexi-utf-16-be-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (let (first-octet-seen) - (labels ((read-next-byte () - (prog1 - (or (funcall reader) - (cond (first-octet-seen - (return-from octets-to-char-code - (recover-from-encoding-error stream - "End of file while in UTF-16 sequence."))) - (t (return-from octets-to-char-code :eof)))) - (setq first-octet-seen t))) - (read-next-word () + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error "End of file while in UTF-16 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) + (flet ((read-next-word () (+ (ash (the octet (read-next-byte)) 8) (the octet (read-next-byte))))) - (let ((word (read-next-word))) - (cond ((<= #xd800 word #xdfff) - (let ((next-word (read-next-word))) - (unless (<= #xdc00 next-word #xdfff) - (return-from octets-to-char-code - (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." - next-word word))) - (+ (ash (logand #b1111111111 word) 10) - (logand #b1111111111 next-word) - #x10000))) - (t word)))))) - -(defmethod octets-to-char-code ((format flexi-utf-32-le-format) reader unreader stream) + (let ((word (read-next-word))) + (declare (type (unsigned-byte 16) word)) + (cond ((<= #xd800 word #xdfff) + (let ((next-word (read-next-word))) + (declare (type (unsigned-byte 16) next-word)) + (unless (<= #xdc00 next-word #xdfff) + (return-from octets-to-char-code + (recover-from-encoding-error "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) + (+ (ash (logand #b1111111111 word) 10) + (logand #b1111111111 next-word) + #x10000))) + (t word))))))) + +(defmethod octets-to-char-code ((format flexi-utf-32-le-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (funcall reader) - (cond (first-octet-seen - (return-from octets-to-char-code - (recover-from-encoding-error stream - "End of file while in UTF-32 sequence."))) - (t (return-from octets-to-char-code :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (loop for count from 0 to 24 by 8 + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error "End of file while in UTF-32 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) + (loop for count of-type fixnum from 0 to 24 by 8 for octet of-type octet = (read-next-byte) sum (ash octet count))))) -(defmethod octets-to-char-code ((format flexi-utf-32-be-format) reader unreader stream) - (declare (ignore unreader)) +(defmethod octets-to-char-code ((format flexi-utf-32-be-format) reader) + (declare #.*standard-optimize-settings*) + (declare (function reader)) (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (funcall reader) - (cond (first-octet-seen - (return-from octets-to-char-code - (recover-from-encoding-error stream - "End of file while in UTF-32 sequence."))) - (t (return-from octets-to-char-code :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (loop for count from 24 downto 0 by 8 + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error "End of file while in UTF-32 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) + (loop for count of-type fixnum from 24 downto 0 by 8 for octet of-type octet = (read-next-byte) sum (ash octet count))))) -(defmethod octets-to-char-code ((format flexi-cr-mixin) reader unreader stream) - (declare (optimize speed)) +(defmethod octets-to-char-code ((format flexi-cr-mixin) reader) + (declare #.*standard-optimize-settings*) (let ((char-code (call-next-method))) (case char-code (#.(char-code #\Return) #.(char-code #\Newline)) (:eof :eof) (otherwise char-code)))) -(defmethod octets-to-char-code ((format flexi-crlf-mixin) reader unreader stream) - (declare (optimize speed)) +(defmethod octets-to-char-code ((format flexi-crlf-mixin) reader) + (declare #.*standard-optimize-settings*) + (declare (function *current-unreader*)) (let ((char-code (call-next-method))) (case char-code (#.(char-code #\Return) @@ -228,7 +247,7 @@ (:eof char-code) ;; if the character we peeked at wasn't a ;; linefeed character we unread its constituents - (otherwise (funcall unreader (code-char next-char-code)) + (otherwise (funcall *current-unreader* (code-char next-char-code)) char-code)))) (:eof :eof) (t char-code)))) Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.4 2008/05/18 00:35:33 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.7 2008/05/18 22:22:30 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,39 +29,46 @@ (in-package :flexi-streams) -(defgeneric char-to-octets (format char writer stream) - (:documentation "Converts the character CHAR to sequence of octets -and sends this sequence to SINK. STREAM will always be a flexi stream -which is used to determine how the character should be converted. -This function does all the work for STREAM-WRITE-CHAR in which case -SINK is the same as STREAM. It is also used in the implementation of -STREAM-WRITE-SEQUENCE below.")) - -(defmethod char-to-octets ((format flexi-latin-1-format) char writer stream) - (declare (optimize speed)) +(defgeneric char-to-octets (format char writer) + (declare #.*standard-optimize-settings*) + (:documentation "Converts the character CHAR to a sequence of octets +using the external format FORMAT. The conversion is performed by +calling the unary function \(which must be a functional object) WRITER +repeatedly each octet. The return value of this function is +unspecified. + +The special variable *CURRENT-STREAM* must be bound correctly whenever +this function is called.")) + +(defmethod char-to-octets ((format flexi-latin-1-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 255) - (signal-encoding-error stream "~S is not a LATIN-1 character." char)) + (signal-encoding-error "~S (code ~A) is not a LATIN-1 character." char octet)) (funcall writer octet))) -(defmethod char-to-octets ((format flexi-ascii-format) char writer stream) - (declare (optimize speed)) +(defmethod char-to-octets ((format flexi-ascii-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 127) - (signal-encoding-error stream "~S is not an ASCII character." char)) + (signal-encoding-error "~S (code ~A) is not an ASCII character." char octet)) (funcall writer octet))) -(defmethod char-to-octets ((format flexi-8-bit-format) char writer stream) - (declare (optimize speed)) +(defmethod char-to-octets ((format flexi-8-bit-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) (with-accessors ((encoding-hash external-format-encoding-hash)) format (let ((octet (gethash (char-code char) encoding-hash))) (unless octet - (signal-encoding-error stream "~S is not in this encoding." char)) + (signal-encoding-error "~S (code ~A) is not in this encoding." char octet)) (funcall writer octet)))) -(defmethod char-to-octets ((format flexi-utf-8-format) char writer stream) - (declare (ignore stream) (optimize speed)) +(defmethod char-to-octets ((format flexi-utf-8-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) (let ((char-code (char-code char))) (tagbody (cond ((< char-code #x80) @@ -79,7 +86,7 @@ ((< char-code #x4000000) (funcall writer (logior #b11111000 (ldb (byte 2 24) char-code))) (go four)) - (t (funcall writer (logior #b11111100 (ldb (byte 1 30) char-code))))) + (t (funcall writer (if (logbitp 30 char-code) #b11111101 #b11111100)))) (funcall writer (logior #b10000000 (ldb (byte 6 24) char-code))) four (funcall writer (logior #b10000000 (ldb (byte 6 18) char-code))) @@ -91,52 +98,63 @@ (funcall writer (logior #b10000000 (ldb (byte 6 0) char-code))) zero))) -(defmethod char-to-octets ((format flexi-utf-16-le-format) char writer stream) - (declare (ignore stream) (optimize speed)) +(defmethod char-to-octets ((format flexi-utf-16-le-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) (flet ((write-word (word) (funcall writer (ldb (byte 8 0) word)) (funcall writer (ldb (byte 8 8) word)))) (let ((char-code (char-code char))) + (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) (write-word char-code)) (t (decf char-code #x10000) (write-word (logior #xd800 (ldb (byte 10 10) char-code))) (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) -(defmethod char-to-octets ((format flexi-utf-16-be-format) char writer stream) - (declare (ignore stream) (optimize speed)) +(defmethod char-to-octets ((format flexi-utf-16-be-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) (flet ((write-word (word) (funcall writer (ldb (byte 8 8) word)) (funcall writer (ldb (byte 8 0) word)))) - (declare (inline write-word) (dynamic-extent (function write-word))) (let ((char-code (char-code char))) + (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) (write-word char-code)) (t (decf char-code #x10000) (write-word (logior #xd800 (ldb (byte 10 10) char-code))) (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) -(defmethod char-to-octets ((format flexi-utf-32-le-format) char writer stream) - (declare (ignore stream) (optimize speed)) - (loop with char-code = (char-code char) - for position in '(0 8 16 24) do - (funcall writer (ldb (byte 8 position) char-code)))) - -(defmethod char-to-octets ((format flexi-utf-32-be-format) char writer stream) - (declare (ignore stream) (optimize speed)) - (loop with char-code = (char-code char) - for position in '(24 16 8 0) do - (funcall writer (ldb (byte 8 position) char-code)))) - -(defmethod char-to-octets ((format flexi-cr-mixin) char writer stream) - (declare (optimize speed)) +(defmethod char-to-octets ((format flexi-utf-32-le-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) + (let ((char-code (char-code char))) + (funcall writer (ldb (byte 8 0) char-code)) + (funcall writer (ldb (byte 8 8) char-code)) + (funcall writer (ldb (byte 8 16) char-code)) + (funcall writer (ldb (byte 8 24) char-code)))) + +(defmethod char-to-octets ((format flexi-utf-32-be-format) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char) (function writer)) + (let ((char-code (char-code char))) + (funcall writer (ldb (byte 8 24) char-code)) + (funcall writer (ldb (byte 8 16) char-code)) + (funcall writer (ldb (byte 8 8) char-code)) + (funcall writer (ldb (byte 8 0) char-code)))) + +(defmethod char-to-octets ((format flexi-cr-mixin) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char)) (if (char= char #\Newline) - (call-next-method format #\Return writer stream) + (call-next-method format #\Return writer) (call-next-method))) -(defmethod char-to-octets ((format flexi-crlf-mixin) char writer stream) - (declare (optimize speed)) +(defmethod char-to-octets ((format flexi-crlf-mixin) char writer) + (declare #.*standard-optimize-settings*) + (declare (character char)) (cond ((char= char #\Newline) - (call-next-method format #\Return writer stream) - (call-next-method format #\Linefeed writer stream)) + (call-next-method format #\Return writer) + (call-next-method format #\Linefeed writer)) (t (call-next-method)))) Modified: branches/edi/external-format.lisp ============================================================================== --- branches/edi/external-format.lisp (original) +++ branches/edi/external-format.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.17 2008/05/18 00:34:19 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.18 2008/05/18 15:54:34 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -52,7 +52,8 @@ a #\Newline will be translated - one of the keywords :CR, :LF, or :CRLF.")) (:documentation "EXTERNAL-FORMAT objects are used to denote -encodings for flexi streams.")) +encodings for flexi streams or for the string functions defined in +strings.lisp.")) (defmethod make-load-form ((thing external-format) &optional environment) "Defines a way to reconstruct external formats. Needed for OpenMCL." @@ -76,21 +77,31 @@ tables.")) (defclass flexi-cr-8-bit-format (flexi-cr-mixin flexi-8-bit-format) - ()) + () + (:documentation "Special class for external formats which use an +8-bit encoding /and/ have #\Return as the line-end character.")) (defclass flexi-crlf-8-bit-format (flexi-crlf-mixin flexi-8-bit-format) - ()) + () + (:documentation "Special class for external formats which use an +8-bit encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) (defclass flexi-ascii-format (flexi-8-bit-format) () (:documentation "Special class for external formats which use the -US-ASCCI encoding.")) +US-ASCII encoding.")) (defclass flexi-cr-ascii-format (flexi-cr-mixin flexi-ascii-format) - ()) + () + (:documentation "Special class for external formats which use the +US-ASCII encoding /and/ have #\Return as the line-end character.")) (defclass flexi-crlf-ascii-format (flexi-crlf-mixin flexi-ascii-format) - ()) + () + (:documentation "Special class for external formats which use the +US-ASCII encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) (defclass flexi-latin-1-format (flexi-8-bit-format) () @@ -98,10 +109,15 @@ ISO-8859-1 encoding.")) (defclass flexi-cr-latin-1-format (flexi-cr-mixin flexi-latin-1-format) - ()) + () + (:documentation "Special class for external formats which use the +ISO-8859-1 encoding /and/ have #\Return as the line-end character.")) (defclass flexi-crlf-latin-1-format (flexi-crlf-mixin flexi-latin-1-format) - ()) + () + (:documentation "Special class for external formats which use the +ISO-8859-1 encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) (defclass flexi-utf-32-format (external-format) () @@ -114,10 +130,16 @@ UTF-32 encoding with little-endian byte ordering.")) (defclass flexi-cr-utf-32-le-format (flexi-cr-mixin flexi-utf-32-le-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with little-endian byte ordering /and/ have #\Return +as the line-end character.")) (defclass flexi-crlf-utf-32-le-format (flexi-crlf-mixin flexi-utf-32-le-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with little-endian byte ordering /and/ have the +sequence #\Return #\Linefeed as the line-end character.")) (defclass flexi-utf-32-be-format (flexi-utf-32-format) () @@ -125,10 +147,16 @@ UTF-32 encoding with big-endian byte ordering.")) (defclass flexi-cr-utf-32-be-format (flexi-cr-mixin flexi-utf-32-be-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with big-endian byte ordering /and/ have #\Return as +the line-end character.")) (defclass flexi-crlf-utf-32-be-format (flexi-crlf-mixin flexi-utf-32-be-format) - ()) + () + (:documentation "Special class for external formats which use the +the UTF-32 encoding with big-endian byte ordering /and/ have the +sequence #\Return #\Linefeed as the line-end character.")) (defclass flexi-utf-16-format (external-format) () @@ -141,10 +169,16 @@ UTF-16 encoding with little-endian byte ordering.")) (defclass flexi-cr-utf-16-le-format (flexi-cr-mixin flexi-utf-16-le-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with little-endian byte ordering /and/ have #\Return +as the line-end character.")) (defclass flexi-crlf-utf-16-le-format (flexi-crlf-mixin flexi-utf-16-le-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with little-endian byte ordering /and/ have the +sequence #\Return #\Linefeed as the line-end character.")) (defclass flexi-utf-16-be-format (flexi-utf-16-format) () @@ -152,10 +186,16 @@ UTF-16 encoding with big-endian byte ordering.")) (defclass flexi-cr-utf-16-be-format (flexi-cr-mixin flexi-utf-16-be-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with big-endian byte ordering /and/ have #\Return as +the line-end character.")) (defclass flexi-crlf-utf-16-be-format (flexi-crlf-mixin flexi-utf-16-be-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with big-endian byte ordering /and/ have the sequence +#\Return #\Linefeed as the line-end character.")) (defclass flexi-utf-8-format (external-format) () @@ -163,14 +203,20 @@ UTF-8 encoding.")) (defclass flexi-cr-utf-8-format (flexi-cr-mixin flexi-utf-8-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-8 encoding /and/ have #\Return as the line-end character.")) (defclass flexi-crlf-utf-8-format (flexi-crlf-mixin flexi-utf-8-format) - ()) + () + (:documentation "Special class for external formats which use the +UTF-8 encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) (defmethod initialize-instance :after ((external-format flexi-8-bit-format) &rest initargs) "Sets the fixed encoding/decoding tables for this particular external format." + (declare #.*standard-optimize-settings*) (declare (ignore initargs)) (with-accessors ((encoding-hash external-format-encoding-hash) (decoding-table flexi-stream-decoding-table) @@ -190,6 +236,9 @@ (cdr (assoc id +code-page-tables+)))))))) (defun external-format-class-name (real-name &key eol-style little-endian id) + "Given the initargs for a general external format returns the name +\(a symbol) of the most specific subclass matching these arguments." + (declare #.*standard-optimize-settings*) (declare (ignore id)) (cond ((ascii-name-p real-name) (ecase eol-style @@ -236,7 +285,10 @@ (defun make-external-format% (name &key (little-endian *default-little-endian*) id eol-style) - "Used internally by MAKE-EXTERNAL-FORMAT." + "Used internally by MAKE-EXTERNAL-FORMAT to default some of the +keywords arguments and to determine the right subclass of +EXTERNAL-FORMAT." + (declare #.*standard-optimize-settings*) (let* ((real-name (normalize-external-format-name name)) (initargs (cond ((or (iso-8859-name-p real-name) @@ -263,6 +315,8 @@ encodings, EOL-STYLE is one of the keywords :CR, :LF, or :CRLF which denote the end-of-line character \(sequence), ID is the ID of a Windows code page \(and ignored for other encodings)." + (declare #.*standard-optimize-settings*) + ;; the keyword arguments are only there for arglist display in the IDE (declare (ignore id little-endian)) (let ((shortcut-args (cdr (assoc name +shortcut-map+)))) (cond (shortcut-args @@ -275,14 +329,15 @@ "Given an external format designator \(a keyword, a list, or an EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT object." + (declare #.*standard-optimize-settings*) (typecase external-format (symbol (make-external-format external-format)) (list (apply #'make-external-format external-format)) (otherwise external-format))) (defun external-format-equal (ef1 ef2) - "Checks whether two EXTERNAL-FORMAT objects denote the same -encoding." + "Checks whether two EXTERNAL-FORMAT objects denote the same encoding." + (declare #.*standard-optimize-settings*) (let* ((name1 (external-format-name ef1)) (code-page-name-p (code-page-name-p name1))) ;; they must habe the same canonical name @@ -306,10 +361,10 @@ (defun normalize-external-format (external-format) "Returns a list which is a `normalized' representation of the -external format EXTERNAL-FORMAT. Used internally by -PRINT-OBJECT, for example. Basically, the result is argument -list that can be fed back to MAKE-EXTERNAL-FORMAT to create an -equivalent object." +external format EXTERNAL-FORMAT. Used internally by PRINT-OBJECT, for +example. Basically, the result is an argument list that can be fed +back to MAKE-EXTERNAL-FORMAT to create an equivalent object." + (declare #.*standard-optimize-settings*) (let ((name (external-format-name external-format)) (eol-style (external-format-eol-style external-format))) (cond ((or (ascii-name-p name) @@ -331,19 +386,45 @@ (print-unreadable-object (object stream :type t :identity t) (prin1 (normalize-external-format object) stream))) -(defgeneric encoding-factor (format)) +(defgeneric encoding-factor (format) + (:documentation "Given an external format FORMAT, returns a factor +which denotes the octets to characters ratio to expect when +encoding/decoding. If the returned value is an integer, the factor is +assumed to be exact. If it is a float, the factor is supposed to be +based on heuristics and usually not exact. + +This factor is used in string.lisp.") + (declare #.*standard-optimize-settings*)) (defmethod encoding-factor ((format flexi-8-bit-format)) + (declare #.*standard-optimize-settings*) + ;; 8-bit encodings map octets to characters in an exact one-to-one + ;; fashion 1) (defmethod encoding-factor ((format flexi-utf-8-format)) + (declare #.*standard-optimize-settings*) + ;; UTF-8 characters can be anything from one to six octets, but we + ;; assume that the "overhead" is only about 5 percent - this + ;; estimate is obviously very much dependant on the content 1.05) (defmethod encoding-factor ((format flexi-utf-16-format)) + (declare #.*standard-optimize-settings*) + ;; usually one character maps to two octets, but characters with + ;; code points above #x10000 map to four octets - we assume that we + ;; usually don't see these characters but of course have to return a + ;; float 2.0) (defmethod encoding-factor ((format flexi-utf-32-format)) + (declare #.*standard-optimize-settings*) + ;; UTF-32 always matches every character to four octets 4) (defmethod encoding-factor ((format flexi-crlf-mixin)) + (declare #.*standard-optimize-settings*) + ;; if the sequence #\Return #\Linefeed is the line-end marker, this + ;; obviously makes encodings potentially longer and definitely makes + ;; the estimate unexact (* 1.02 (call-next-method))) \ No newline at end of file Modified: branches/edi/flexi-streams.asd ============================================================================== --- branches/edi/flexi-streams.asd (original) +++ branches/edi/flexi-streams.asd Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.60 2008/05/17 15:56:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.62 2008/05/18 20:34:52 edi Exp $ ;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. @@ -38,17 +38,18 @@ :version "0.14.0" :serial t :components ((:file "packages") + (:file "mapping") (:file "ascii") (:file "koi8-r") (:file "iso-8859") (:file "code-pages") (:file "specials") (:file "util") + (:file "conditions") (:file "external-format") (:file "encode") (:file "decode") (:file "in-memory") - (:file "conditions") (:file "stream") #+:lispworks (:file "lw-binary-stream") (:file "output") Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.57 2008/05/17 16:44:53 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.59 2008/05/18 21:39:40 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -148,15 +148,15 @@ (octet-stack flexi-stream-octet-stack) (external-format flexi-stream-external-format)) flexi-input-stream - (let ((counter 0) octets-reversed) + (let ((*current-stream* flexi-input-stream) + (counter 0) octets-reversed) (declare (integer position) (fixnum counter)) (char-to-octets external-format char (lambda (octet) (incf counter) - (push octet octets-reversed)) - nil) + (push octet octets-reversed))) (decf position counter) (setq octet-stack (nreconc octets-reversed octet-stack))))) @@ -172,12 +172,12 @@ ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after ;; this operation (setq last-octet nil) - (let ((char-code (octets-to-char-code external-format - (lambda () - (read-byte* stream)) - (lambda (char) - (unread-char% char stream)) - stream))) + (let* ((*current-unreader* (lambda (char) + (unread-char% char stream))) + (*current-stream* stream) + (char-code (octets-to-char-code external-format + (lambda () + (read-byte* stream))))) ;; remember this character and its char code for UNREAD-CHAR (setq last-char-code char-code) (or (code-char char-code) char-code)))) Modified: branches/edi/iso-8859.lisp ============================================================================== --- branches/edi/iso-8859.lisp (original) +++ branches/edi/iso-8859.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/iso-8859.lisp,v 1.6 2008/05/17 13:50:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/iso-8859.lisp,v 1.7 2008/05/18 21:32:15 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -32,22 +32,22 @@ ;;; the following code was auto-generated from files which can be ;;; found at <ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/> -(defvar +iso-8859-tables+ - '((:iso-8859-1 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)) - (:iso-8859-2 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 728 321 164 317 346 167 168 352 350 356 377 173 381 379 176 261 731 322 180 318 347 711 184 353 351 357 378 733 382 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729)) - (:iso-8859-3 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 294 728 163 164 65533 292 167 168 304 350 286 308 173 65533 379 176 295 178 179 180 181 293 183 184 305 351 287 309 189 65533 380 192 193 194 65533 196 266 264 199 200 201 202 203 204 205 206 207 65533 209 210 211 212 288 214 215 284 217 218 219 220 364 348 223 224 225 226 65533 228 267 265 231 232 233 234 235 236 237 238 239 65533 241 242 243 244 289 246 247 285 249 250 251 252 365 349 729)) - (:iso-8859-4 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 312 342 164 296 315 167 168 352 274 290 358 173 381 175 176 261 731 343 180 297 316 711 184 353 275 291 359 330 382 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 298 272 325 332 310 212 213 214 215 216 370 218 219 220 360 362 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 299 273 326 333 311 244 245 246 247 248 371 250 251 252 361 363 729)) - (:iso-8859-5 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 173 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 8470 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 167 1118 1119)) - (:iso-8859-6 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 65533 65533 164 65533 65533 65533 65533 65533 65533 65533 1548 173 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 1563 65533 65533 65533 1567 65533 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 65533 65533 65533 65533 65533 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533)) - (:iso-8859-7 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8216 8217 163 8364 8367 166 167 168 169 890 171 172 173 65533 8213 176 177 178 179 900 901 902 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533)) - (:iso-8859-8 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 162 163 164 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 8215 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533)) - (:iso-8859-9 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255)) - (:iso-8859-10 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 274 290 298 296 310 167 315 272 352 358 381 173 362 330 176 261 275 291 299 297 311 183 316 273 353 359 382 8213 363 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 207 208 325 332 211 212 213 214 360 216 370 218 219 220 221 222 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 239 240 326 333 243 244 245 246 361 248 371 250 251 252 253 254 312)) - (:iso-8859-11 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 65533 65533 65533 65533 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 65533 65533 65533 65533)) - (:iso-8859-13 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8221 162 163 164 8222 166 167 216 169 342 171 172 173 174 198 176 177 178 179 8220 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 8217)) - (:iso-8859-14 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 7682 7683 163 266 267 7690 167 7808 169 7810 7691 7922 173 174 376 7710 7711 288 289 7744 7745 182 7766 7809 7767 7811 7776 7923 7812 7813 7777 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 372 209 210 211 212 213 214 7786 216 217 218 219 220 221 374 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 373 241 242 243 244 245 246 7787 248 249 250 251 252 253 375 255)) - (:iso-8859-15 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 8364 165 352 167 353 169 170 171 172 173 174 175 176 177 178 179 381 181 182 183 382 185 186 187 338 339 376 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)) - (:iso-8859-16 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 261 321 8364 8222 352 167 353 169 536 171 377 173 378 379 176 177 268 322 381 8221 182 183 382 269 537 187 338 339 376 380 192 193 194 258 196 262 198 199 200 201 202 203 204 205 206 207 272 323 210 211 212 336 214 346 368 217 218 219 220 280 538 223 224 225 226 259 228 263 230 231 232 233 234 235 236 237 238 239 273 324 242 243 244 337 246 347 369 249 250 251 252 281 539 255))) +(defconstant +iso-8859-tables+ + `((:iso-8859-1 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))) + (:iso-8859-2 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 728 321 164 317 346 167 168 352 350 356 377 173 381 379 176 261 731 322 180 318 347 711 184 353 351 357 378 733 382 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729))) + (:iso-8859-3 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 294 728 163 164 65533 292 167 168 304 350 286 308 173 65533 379 176 295 178 179 180 181 293 183 184 305 351 287 309 189 65533 380 192 193 194 65533 196 266 264 199 200 201 202 203 204 205 206 207 65533 209 210 211 212 288 214 215 284 217 218 219 220 364 348 223 224 225 226 65533 228 267 265 231 232 233 234 235 236 237 238 239 65533 241 242 243 244 289 246 247 285 249 250 251 252 365 349 729))) + (:iso-8859-4 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 312 342 164 296 315 167 168 352 274 290 358 173 381 175 176 261 731 343 180 297 316 711 184 353 275 291 359 330 382 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 298 272 325 332 310 212 213 214 215 216 370 218 219 220 360 362 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 299 273 326 333 311 244 245 246 247 248 371 250 251 252 361 363 729))) + (:iso-8859-5 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 173 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 8470 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 167 1118 1119))) + (:iso-8859-6 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 65533 65533 164 65533 65533 65533 65533 65533 65533 65533 1548 173 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 1563 65533 65533 65533 1567 65533 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 65533 65533 65533 65533 65533 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533))) + (:iso-8859-7 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8216 8217 163 8364 8367 166 167 168 169 890 171 172 173 65533 8213 176 177 178 179 900 901 902 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533))) + (:iso-8859-8 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 162 163 164 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 8215 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533))) + (:iso-8859-9 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255))) + (:iso-8859-10 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 274 290 298 296 310 167 315 272 352 358 381 173 362 330 176 261 275 291 299 297 311 183 316 273 353 359 382 8213 363 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 207 208 325 332 211 212 213 214 360 216 370 218 219 220 221 222 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 239 240 326 333 243 244 245 246 361 248 371 250 251 252 253 254 312))) + (:iso-8859-11 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 65533 65533 65533 65533 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 65533 65533 65533 65533))) + (:iso-8859-13 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8221 162 163 164 8222 166 167 216 169 342 171 172 173 174 198 176 177 178 179 8220 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 8217))) + (:iso-8859-14 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 7682 7683 163 266 267 7690 167 7808 169 7810 7691 7922 173 174 376 7710 7711 288 289 7744 7745 182 7766 7809 7767 7811 7776 7923 7812 7813 7777 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 372 209 210 211 212 213 214 7786 216 217 218 219 220 221 374 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 373 241 242 243 244 245 246 7787 248 249 250 251 252 253 375 255))) + (:iso-8859-15 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 8364 165 352 167 353 169 170 171 172 173 174 175 176 177 178 179 381 181 182 183 382 185 186 187 338 339 376 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))) + (:iso-8859-16 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 261 321 8364 8222 352 167 353 169 536 171 377 173 378 379 176 177 268 322 381 8221 182 183 382 269 537 187 338 339 376 380 192 193 194 258 196 262 198 199 200 201 202 203 204 205 206 207 272 323 210 211 212 336 214 346 368 217 218 219 220 280 538 223 224 225 226 259 228 263 230 231 232 233 234 235 236 237 238 239 273 324 242 243 244 337 246 347 369 249 250 251 252 281 539 255)))) "A list of the ISO-8859 encodings where each element is a cons with the car being a keyword denoting the encoding and the cdr being a vector enumerating the corresponding character codes.") Modified: branches/edi/koi8-r.lisp ============================================================================== --- branches/edi/koi8-r.lisp (original) +++ branches/edi/koi8-r.lisp Sun May 18 18:27:36 2008 @@ -1,6 +1,36 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/koi8-r.lisp,v 1.2 2008/05/18 21:32:15 edi Exp $ + +;;; Copyright (c) 2006, Igor Plekhov. All rights reserved. +;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + (in-package :flexi-streams) ;; http://unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-R.TXT -(defvar +koi8-r-table+ - #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 9472 9474 9484 9488 9492 9496 9500 9508 9516 9524 9532 9600 9604 9608 9612 9616 9617 9618 9619 8992 9632 8729 8730 8776 8804 8805 160 8993 176 178 183 247 9552 9553 9554 1105 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 1025 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 169 1102 1072 1073 1094 1076 1077 1092 1075 1093 1080 1081 1082 1083 1084 1085 1086 1087 1103 1088 1089 1090 1091 1078 1074 1100 1099 1079 1096 1101 1097 1095 1098 1070 1040 1041 1062 1044 1045 1060 1043 1061 1048 1049 1050 1051 1052 1053 1054 1055 1071 1056 1057 1058 1059 1046 1042 1068 1067 1047 1064 1069 1065 1063 1066) +(defconstant +koi8-r-table+ + (make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 9472 9474 9484 9488 9492 9496 9500 9508 9516 9524 9532 9600 9604 9608 9612 9616 9617 9618 9619 8992 9632 8729 8730 8776 8804 8805 160 8993 176 178 183 247 9552 9553 9554 1105 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 1025 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 169 1102 1072 1073 1094 1076 1077 1092 1075 1093 1080 1081 1082 1083 1084 1085 1086 1087 1103 1088 1089 1090 1091 1078 1074 1100 1099 1079 1096 1101 1097 1095 1098 1070 1040 1041 1062 1044 1045 1060 1043 1061 1048 1049 1050 1051 1052 1053 1054 1055 1071 1056 1057 1058 1059 1046 1042 1068 1067 1047 1064 1069 1065 1063 1066)) "An array enumerating the character codes for the KOI8-R encoding.") Added: branches/edi/mapping.lisp ============================================================================== --- (empty file) +++ branches/edi/mapping.lisp Sun May 18 18:27:36 2008 @@ -0,0 +1,67 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.15 2008/05/18 15:54:34 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(deftype octet () + "A shortcut for \(UNSIGNED-BYTE 8)." + '(unsigned-byte 8)) + +(deftype char* () + "Convenience shortcut to paper over the difference between LispWorks +and the other Lisps." + #+:lispworks 'lw:simple-char + #-:lispworks 'character) + +(deftype char-code-integer () + "The type of integers which can be returned by the function CHAR-CODE." + '(integer 0 #.(1- char-code-limit))) + +(defmacro defconstant (name value &optional doc) + "Make sure VALUE is evaluated only once \(to appease SBCL)." + `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value) + ,@(when doc (list doc)))) + +(defun invert-table (table) + "`Inverts' an array which maps octets to character codes to a hash +table which maps character codes to octets." + (let ((hash (make-hash-table))) + (loop for octet from 0 + for char-code across table + unless (= char-code 65533) + do (setf (gethash char-code hash) octet)) + hash)) + +(defun make-decoding-table (list) + "Creates and returns an array which contains the elements in the +list LIST and has an element type that's suitable for character +codes." + (make-array (length list) + :element-type 'char-code-integer + :initial-contents list)) \ No newline at end of file Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.47 2008/05/17 16:40:33 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.49 2008/05/18 22:22:30 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -66,11 +66,11 @@ (declare (optimize speed)) (with-accessors ((external-format flexi-stream-external-format)) stream - (char-to-octets external-format - char - (lambda (octet) - (write-byte* octet stream)) - stream))) + (let ((*current-stream* stream)) + (char-to-octets external-format + char + (lambda (octet) + (write-byte* octet stream)))))) (defmethod stream-write-char :after ((stream flexi-output-stream) char) (declare (optimize speed)) @@ -155,6 +155,7 @@ (stream-write-byte flexi-output-stream element)) sequence)))) +#+(or) (defmethod stream-write-sequence ((stream flexi-output-stream) (sequence string) start end &key) "Optimized method for the cases where SEQUENCE is a string. Fills an internal buffer and uses repeated calls to WRITE-SEQUENCE to write @@ -174,14 +175,14 @@ :test #'char= :start start :end end - :from-end t))) + :from-end t)) + (*current-stream* stream)) (loop with format = (flexi-stream-external-format stream) for index from start below end do (char-to-octets format (aref sequence index) (lambda (octet) - (vector-push octet buffer)) - stream) + (vector-push octet buffer))) when (>= (fill-pointer buffer) +buffer-size+) do (write-sequence buffer (flexi-stream-stream stream)) (setf (fill-pointer buffer) 0) Modified: branches/edi/packages.lisp ============================================================================== --- branches/edi/packages.lisp (original) +++ branches/edi/packages.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.31 2008/05/17 13:50:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.32 2008/05/18 21:32:15 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -34,9 +34,9 @@ (defpackage :flexi-streams (:use :cl :trivial-gray-streams) - (:nicknames :flex) - #+:lispworks - (:shadow :with-accessors) + (:nicknames :flex) + (:shadow #+:lispworks :with-accessors + :defconstant) (:export :*default-eol-style* :*default-little-endian* :*substitution-char* Modified: branches/edi/specials.lisp ============================================================================== --- branches/edi/specials.lisp (original) +++ branches/edi/specials.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.28 2008/05/18 14:59:00 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.30 2008/05/18 21:32:15 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -38,15 +38,20 @@ (compilation-speed 0)) "The standard optimize settings used by most declaration expressions.") -(deftype octet () - "A shortcut for \(UNSIGNED-BYTE 8)." - '(unsigned-byte 8)) - -(deftype char* () - "Convenience shortcut to paper over the difference between LispWorks -and the other Lisps." - #+:lispworks 'lw:simple-char - #-:lispworks 'character) +(defvar *current-stream* nil + "The `stream' that is currently read from or written to. Not +necessarily a stream, can be any source or sink, like an array or a +list. Mainly used for error reporting. + +Must be bound to a suitable value when OCTETS-TO-CHAR-CODE or +CHAR-TO-OCTETS are called.") + +(defvar *current-unreader* nil + "A unary function which might be called to `unread' a character +\(i.e. the sequence of octets it represents). + +Used by the function OCTETS-TO-CHAR-CODE and must always be bound to a +suitable functional object when this function is called.") (defvar +name-map+ '((:utf8 . :utf-8) @@ -144,33 +149,23 @@ \(as if by a USE-VALUE restart) whenever during reading an error of type FLEXI-STREAM-ENCODING-ERROR would have been signalled otherwise.") -(defun invert-table (table) - "`Inverts' an array which maps octets to character codes to a -hash tables which maps character codes to octets." - (let ((hash (make-hash-table))) - (loop for octet from 0 - for char-code across table - unless (= char-code 65533) - do (setf (gethash char-code hash) octet)) - hash)) - -(defvar +iso-8859-hashes+ +(defconstant +iso-8859-hashes+ (loop for (name . table) in +iso-8859-tables+ collect (cons name (invert-table table))) "An alist which maps names for ISO-8859 encodings to hash tables which map character codes to the corresponding octets.") -(defvar +code-page-hashes+ +(defconstant +code-page-hashes+ (loop for (id . table) in +code-page-tables+ collect (cons id (invert-table table))) "An alist which maps IDs of Windows code pages to hash tables which map character codes to the corresponding octets.") -(defvar +ascii-hash+ (invert-table +ascii-table+) +(defconstant +ascii-hash+ (invert-table +ascii-table+) "A hash table which maps US-ASCII character codes to the corresponding octets.") -(defvar +koi8-r-hash+ (invert-table +koi8-r-table+) +(defconstant +koi8-r-hash+ (invert-table +koi8-r-table+) "A hash table which maps KOI8-R character codes to the corresponding octets.") Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.10 2008/05/18 14:59:00 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.12 2008/05/18 22:22:30 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -38,7 +38,8 @@ (declare (fixnum start end) (string string)) (setq external-format (maybe-convert-external-format external-format)) (let ((factor (encoding-factor external-format)) - (length (- end start))) + (length (- end start)) + (*current-stream* string)) (etypecase factor (float (let ((octets (make-array (round (* factor length)) @@ -50,24 +51,19 @@ (loop for i of-type fixnum from start below end do (char-to-octets external-format (char string i) - #'writer - nil))) + #'writer))) octets)) (integer - (let ((octets (make-array (* factor length) - :element-type 'octet)) + (let ((octets (make-array (* factor length) :element-type 'octet)) (j 0)) (declare (fixnum j)) (flet ((writer (octet) - (setf #+:lispworks (sys:typed-aref '(unsigned-byte 8) octets j) - #-:lispworks (aref octets j) - octet) + (setf (aref (the (array octet *) octets) j) octet) (incf j))) (loop for i of-type fixnum from start below end do (char-to-octets external-format (char string i) - #'writer - nil))) + #'writer))) octets))))) (defun octets-to-string (sequence &key @@ -82,14 +78,13 @@ (length (- end start)) (i start) (reader (etypecase sequence - #+:lispworks ((array octet *) (lambda () (when (>= i end) - ;; TODO... + ;; TODO... -> NIL? (error "End of data.")) (prog1 - (sys:typed-aref '(unsigned-byte 8) sequence i) + (aref (the (array octet *) sequence) i) (incf i)))) ((array * *) (lambda () @@ -106,22 +101,17 @@ (error "End of data.")) (prog1 (nth i sequence) - (incf i))))))) + (incf i)))))) + (*current-stream* sequence) + (*current-unreader* (lambda (char) + (char-to-octets external-format + char + (lambda (octet) + (declare (ignore octet)) + (decf i)))))) (declare (fixnum i)) - (labels ((pseudo-writer (octet) - (declare (ignore octet)) - (decf i)) - (unreader (char) - (char-to-octets external-format - char - #'pseudo-writer - nil)) - (next-char () - (code-char - (octets-to-char-code external-format - reader - #'unreader - nil)))) + (flet ((next-char () + (code-char (octets-to-char-code external-format reader)))) (etypecase factor (float (let ((string (make-array (round (/ length factor)) Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Sun May 18 18:27:36 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.14 2008/05/17 13:50:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.16 2008/05/18 20:34:53 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -108,6 +108,7 @@ (unless (find real-name +name-map+ :test #'eq :key #'cdr) + ;; TODO... (error "~S is not known to be a name for an external format." name)) real-name)) @@ -161,6 +162,8 @@ (defmacro with-accessors (slot-entries instance &body body) "For LispWorks, we prefer SLOT-VALUE over accessors for better performance." + ;; note that we assume that the variables have the same names as the + ;; slots `(with-slots ,(mapcar #'car slot-entries) ,instance ,@body)) \ No newline at end of file

1 0

[flexi-streams-cvs] r29 - in branches/edi: . doc test
by eweitz＠common-lisp.net 18 May '08

18 May '08

Author: eweitz Date: Sun May 18 10:59:44 2008 New Revision: 29 Modified: branches/edi/doc/index.html branches/edi/specials.lisp branches/edi/strings.lisp branches/edi/test/test.lisp Log: Some optimization Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Sun May 18 10:59:44 2008 @@ -977,8 +977,8 @@ Converts the Lisp string <code>string</code> from <code>start</code> to <code>end</code> to an array of <a href="#octet">octets</a> corresponding to the <a href="#external-formats">external format</a> <code>external-format</code>. The defaults for <code>start</code> and <code>end</code> -are <code>0</code> and <code>NIL</code> (meaning the length of the -vector). The default for <code>external-format</code> is the +are <code>0</code> and the length of the +string. The default for <code>external-format</code> is the value of evaluating <code>(<a href="#make-external-format">MAKE-EXTERNAL-FORMAT</a> :LATIN1)</code> @@ -986,15 +986,15 @@ </blockquote> [Function] - <a class=none name="octets-to-string">octets-to-string vector <tt>&key</tt> external-format start end => string</a> + <a class=none name="octets-to-string">octets-to-string sequence <tt>&key</tt> external-format start end => string</a> -<blockquote> Converts the Lisp vector <code>vector</code> +<blockquote> Converts the Lisp sequence <code>sequence</code> of <a href="#octet">octets</a> from <code>start</code> to <code>end</code> to string using the <a href="#external-formats">external format</a> <code>external-format</code>. The defaults for <code>start</code> and <code>end</code> -are <code>0</code> and the length of the vector. The default +are <code>0</code> and the length of the sequence. The default for <code>external-format</code> is the value of evaluating <code>(<a href="#make-external-format">MAKE-EXTERNAL-FORMAT</a> :LATIN1)</code> @@ -1037,7 +1037,7 @@ numerous patches and additions. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.98 2007/12/29 23:15:27 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.100 2008/05/18 14:59:02 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: branches/edi/specials.lisp ============================================================================== --- branches/edi/specials.lisp (original) +++ branches/edi/specials.lisp Sun May 18 10:59:44 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.27 2008/05/18 01:21:34 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.28 2008/05/18 14:59:00 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,6 +29,15 @@ (in-package :flexi-streams) +(defvar *standard-optimize-settings* + '(optimize + speed + (safety 0) + (space 0) + (debug 1) + (compilation-speed 0)) + "The standard optimize settings used by most declaration expressions.") + (deftype octet () "A shortcut for \(UNSIGNED-BYTE 8)." '(unsigned-byte 8)) Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Sun May 18 10:59:44 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.9 2008/05/18 13:59:13 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.10 2008/05/18 14:59:00 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -34,6 +34,8 @@ (start 0) (end (length string))) "Converts the Lisp string STRING from START to END to an array of octets corresponding to the external format EXTERNAL-FORMAT." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end) (string string)) (setq external-format (maybe-convert-external-format external-format)) (let ((factor (encoding-factor external-format)) (length (- end start))) @@ -45,7 +47,7 @@ :adjustable t))) (flet ((writer (octet) (vector-push-extend octet octets))) - (loop for i from start below end + (loop for i of-type fixnum from start below end do (char-to-octets external-format (char string i) #'writer @@ -55,33 +57,58 @@ (let ((octets (make-array (* factor length) :element-type 'octet)) (j 0)) + (declare (fixnum j)) (flet ((writer (octet) - (setf (aref octets j) octet) + (setf #+:lispworks (sys:typed-aref '(unsigned-byte 8) octets j) + #-:lispworks (aref octets j) + octet) (incf j))) - (loop for i from start below end do + (loop for i of-type fixnum from start below end do (char-to-octets external-format (char string i) #'writer nil))) octets))))) -(defun octets-to-string (vector &key - (external-format (make-external-format :latin1)) - (start 0) (end (length vector))) - "Converts the Lisp vector VECTOR of octets from START to END to +(defun octets-to-string (sequence &key + (external-format (make-external-format :latin1)) + (start 0) (end (length sequence))) + "Converts the Lisp sequence SEQUENCE of octets from START to END to string using the external format EXTERNAL-FORMAT." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) (setq external-format (maybe-convert-external-format external-format)) - (let ((factor (encoding-factor external-format)) - (length (- end start)) - (i start)) - (labels ((reader () - (when (>= i end) - ;; TODO... - (error "End of data.")) - (prog1 - (aref vector i) - (incf i))) - (pseudo-writer (octet) + (let* ((factor (encoding-factor external-format)) + (length (- end start)) + (i start) + (reader (etypecase sequence + #+:lispworks + ((array octet *) + (lambda () + (when (>= i end) + ;; TODO... + (error "End of data.")) + (prog1 + (sys:typed-aref '(unsigned-byte 8) sequence i) + (incf i)))) + ((array * *) + (lambda () + (when (>= i end) + ;; TODO... + (error "End of data.")) + (prog1 + (aref sequence i) + (incf i)))) + (list + (lambda () + (when (>= i end) + ;; TODO... + (error "End of data.")) + (prog1 + (nth i sequence) + (incf i))))))) + (declare (fixnum i)) + (labels ((pseudo-writer (octet) (declare (ignore octet)) (decf i)) (unreader (char) @@ -92,7 +119,7 @@ (next-char () (code-char (octets-to-char-code external-format - #'reader + reader #'unreader nil)))) (etypecase factor @@ -108,6 +135,7 @@ (let* ((string-length (/ length factor)) (string (make-array string-length :element-type 'char*))) - (loop for j from 0 below string-length - do (setf (char string j) (next-char)) + (declare (fixnum string-length)) + (loop for j of-type fixnum from 0 below string-length + do (setf (schar string j) (next-char)) finally (return string)))))))) Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Sun May 18 10:59:44 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.21 2008/05/18 01:21:36 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.22 2008/05/18 14:59:04 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -263,10 +263,12 @@ that the stream conversion functions work." (let* ((full-path (merge-pathnames pathspec *this-file*)) (octets-vector (file-as-octet-vector full-path)) + (octets-list (coerce octets-vector 'list)) (string (file-as-string full-path external-format))) (with-test ((format nil "String tests with format ~S." (flex::normalize-external-format external-format))) (check (string= (octets-to-string octets-vector :external-format external-format) string)) + (check (string= (octets-to-string octets-list :external-format external-format) string)) (check (equalp (string-to-octets string :external-format external-format) octets-vector))))) (defmacro using-values ((&rest values) &body body)

1 0

[flexi-streams-cvs] r28 - branches/edi
by eweitz＠common-lisp.net 18 May '08

18 May '08

Author: eweitz Date: Sun May 18 10:01:12 2008 New Revision: 28 Modified: branches/edi/strings.lisp Log: Reduce consing Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Sun May 18 10:01:12 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.8 2008/05/18 01:21:34 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.9 2008/05/18 13:59:13 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -36,31 +36,33 @@ octets corresponding to the external format EXTERNAL-FORMAT." (setq external-format (maybe-convert-external-format external-format)) (let ((factor (encoding-factor external-format)) - (length (- end start))) + (length (- end start))) (etypecase factor (float (let ((octets (make-array (round (* factor length)) :element-type 'octet :fill-pointer 0 :adjustable t))) - (loop for i from start below end - do (char-to-octets external-format - (char string i) - (lambda (octet) - (vector-push-extend octet octets)) - nil)) + (flet ((writer (octet) + (vector-push-extend octet octets))) + (loop for i from start below end + do (char-to-octets external-format + (char string i) + #'writer + nil))) octets)) (integer (let ((octets (make-array (* factor length) - :element-type 'octet))) - (loop with j = 0 - for i from start below end - do (char-to-octets external-format - (char string i) - (lambda (octet) - (setf (aref octets j) octet) - (incf j)) - nil)) + :element-type 'octet)) + (j 0)) + (flet ((writer (octet) + (setf (aref octets j) octet) + (incf j))) + (loop for i from start below end do + (char-to-octets external-format + (char string i) + #'writer + nil))) octets))))) (defun octets-to-string (vector &key @@ -72,24 +74,27 @@ (let ((factor (encoding-factor external-format)) (length (- end start)) (i start)) - (flet ((next-char () - (code-char - (octets-to-char-code external-format - (lambda () - (when (>= i end) - ;; TODO... - (error "End of data.")) - (prog1 - (aref vector i) - (incf i))) - (lambda (char) - (char-to-octets external-format - char - (lambda (octet) - (declare (ignore octet)) - (decf i)) - nil)) - nil)))) + (labels ((reader () + (when (>= i end) + ;; TODO... + (error "End of data.")) + (prog1 + (aref vector i) + (incf i))) + (pseudo-writer (octet) + (declare (ignore octet)) + (decf i)) + (unreader (char) + (char-to-octets external-format + char + #'pseudo-writer + nil)) + (next-char () + (code-char + (octets-to-char-code external-format + #'reader + #'unreader + nil)))) (etypecase factor (float (let ((string (make-array (round (/ length factor))

1 0

[flexi-streams-cvs] r27 - in branches/edi: . test
by eweitz＠common-lisp.net 18 May '08

18 May '08

Author: eweitz Date: Sat May 17 21:23:53 2008 New Revision: 27 Modified: branches/edi/decode.lisp branches/edi/encode.lisp branches/edi/external-format.lisp branches/edi/specials.lisp branches/edi/stream.lisp branches/edi/strings.lisp branches/edi/test/test.lisp Log: New implementation for string functions Passes all tests Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Sat May 17 21:23:53 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.2 2008/05/17 16:35:58 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.4 2008/05/18 00:35:33 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -210,28 +210,26 @@ sum (ash octet count))))) (defmethod octets-to-char-code ((format flexi-cr-mixin) reader unreader stream) - "The `base' method for all streams which need end-of-line -conversion. Uses CALL-NEXT-METHOD to do the actual work of reading -one or more encoded characters." (declare (optimize speed)) (let ((char-code (call-next-method))) - (when (eq char-code :eof) - (return-from octets-to-char-code :eof)) - (with-accessors ((eol-style external-format-eol-style)) - format - (cond ((= char-code #.(char-code #\Return)) - (case eol-style - (:cr #.(char-code #\Newline)) - ;; in the case :CRLF we have to look ahead one character - (:crlf (let ((next-char-code (call-next-method))) - (case next-char-code - (#.(char-code #\Linefeed) - #.(char-code #\Newline)) - (:eof char-code) - ;; if the character we peeked at wasn't a - ;; linefeed character we unread its constituents - (otherwise - (funcall unreader (code-char next-char-code)) - char-code)))))) - (t char-code))))) + (case char-code + (#.(char-code #\Return) #.(char-code #\Newline)) + (:eof :eof) + (otherwise char-code)))) + +(defmethod octets-to-char-code ((format flexi-crlf-mixin) reader unreader stream) + (declare (optimize speed)) + (let ((char-code (call-next-method))) + (case char-code + (#.(char-code #\Return) + (let ((next-char-code (call-next-method))) + (case next-char-code + (#.(char-code #\Linefeed) #.(char-code #\Newline)) + (:eof char-code) + ;; if the character we peeked at wasn't a + ;; linefeed character we unread its constituents + (otherwise (funcall unreader (code-char next-char-code)) + char-code)))) + (:eof :eof) + (t char-code)))) Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Sat May 17 21:23:53 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.2 2008/05/17 16:35:58 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.4 2008/05/18 00:35:33 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -42,16 +42,14 @@ (let ((octet (char-code char))) (when (> octet 255) (signal-encoding-error stream "~S is not a LATIN-1 character." char)) - (funcall writer octet)) - char) + (funcall writer octet))) (defmethod char-to-octets ((format flexi-ascii-format) char writer stream) (declare (optimize speed)) (let ((octet (char-code char))) (when (> octet 127) (signal-encoding-error stream "~S is not an ASCII character." char)) - (funcall writer octet)) - char) + (funcall writer octet))) (defmethod char-to-octets ((format flexi-8-bit-format) char writer stream) (declare (optimize speed)) @@ -60,8 +58,7 @@ (let ((octet (gethash (char-code char) encoding-hash))) (unless octet (signal-encoding-error stream "~S is not in this encoding." char)) - (funcall writer octet)) - char)) + (funcall writer octet)))) (defmethod char-to-octets ((format flexi-utf-8-format) char writer stream) (declare (ignore stream) (optimize speed)) @@ -92,8 +89,7 @@ (funcall writer (logior #b10000000 (ldb (byte 6 6) char-code))) one (funcall writer (logior #b10000000 (ldb (byte 6 0) char-code))) - zero)) - char) + zero))) (defmethod char-to-octets ((format flexi-utf-16-le-format) char writer stream) (declare (ignore stream) (optimize speed)) @@ -105,8 +101,7 @@ (write-word char-code)) (t (decf char-code #x10000) (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) - char) + (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) (defmethod char-to-octets ((format flexi-utf-16-be-format) char writer stream) (declare (ignore stream) (optimize speed)) @@ -119,33 +114,29 @@ (write-word char-code)) (t (decf char-code #x10000) (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) - char) + (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) (defmethod char-to-octets ((format flexi-utf-32-le-format) char writer stream) (declare (ignore stream) (optimize speed)) (loop with char-code = (char-code char) for position in '(0 8 16 24) do - (funcall writer (ldb (byte 8 position) char-code))) - char) + (funcall writer (ldb (byte 8 position) char-code)))) (defmethod char-to-octets ((format flexi-utf-32-be-format) char writer stream) (declare (ignore stream) (optimize speed)) (loop with char-code = (char-code char) for position in '(24 16 8 0) do - (funcall writer (ldb (byte 8 position) char-code))) - char) + (funcall writer (ldb (byte 8 position) char-code)))) (defmethod char-to-octets ((format flexi-cr-mixin) char writer stream) - "The `base' method for all formats which need end-of-line -conversion. Uses CALL-NEXT-METHOD to do the actual work of sending -one or more characters to SINK." (declare (optimize speed)) - (case char - (#\Newline - (case (external-format-eol-style format) - (:cr (call-next-method format #\Return writer stream)) - (:crlf (call-next-method format #\Return writer stream) - (call-next-method format #\Linefeed writer stream)))) - (otherwise (call-next-method))) - char) + (if (char= char #\Newline) + (call-next-method format #\Return writer stream) + (call-next-method))) + +(defmethod char-to-octets ((format flexi-crlf-mixin) char writer stream) + (declare (optimize speed)) + (cond ((char= char #\Newline) + (call-next-method format #\Return writer stream) + (call-next-method format #\Linefeed writer stream)) + (t (call-next-method)))) Modified: branches/edi/external-format.lisp ============================================================================== --- branches/edi/external-format.lisp (original) +++ branches/edi/external-format.lisp Sat May 17 21:23:53 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.15 2008/05/17 16:38:24 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.17 2008/05/18 00:34:19 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -60,9 +60,13 @@ (defclass flexi-cr-mixin () () - (:documentation "A mixin for external-formats which need -end-of-line conversion, i.e. for those where the end-of-line -designator is /not/ the single character #\Linefeed.")) + (:documentation "A mixin for external-formats where the end-of-line +designator is #\Return.")) + +(defclass flexi-crlf-mixin () + () + (:documentation "A mixin for external-formats where the end-of-line +designator is the sequence #\Return #\Linefeed.")) (defclass flexi-8-bit-format (external-format) ((encoding-hash :accessor external-format-encoding-hash) @@ -72,9 +76,10 @@ tables.")) (defclass flexi-cr-8-bit-format (flexi-cr-mixin flexi-8-bit-format) - () - (:documentation "The class for all external formats which use an -8-bit encoding /and/ need end-of-line conversion.")) + ()) + +(defclass flexi-crlf-8-bit-format (flexi-crlf-mixin flexi-8-bit-format) + ()) (defclass flexi-ascii-format (flexi-8-bit-format) () @@ -82,9 +87,10 @@ US-ASCCI encoding.")) (defclass flexi-cr-ascii-format (flexi-cr-mixin flexi-ascii-format) - () - (:documentation "Special class for external formats which use the -US-ASCCI encoding /and/ need end-of-line conversion.")) + ()) + +(defclass flexi-crlf-ascii-format (flexi-crlf-mixin flexi-ascii-format) + ()) (defclass flexi-latin-1-format (flexi-8-bit-format) () @@ -92,53 +98,64 @@ ISO-8859-1 encoding.")) (defclass flexi-cr-latin-1-format (flexi-cr-mixin flexi-latin-1-format) + ()) + +(defclass flexi-crlf-latin-1-format (flexi-crlf-mixin flexi-latin-1-format) + ()) + +(defclass flexi-utf-32-format (external-format) () - (:documentation "Special class for external formats which use the -ISO-8859-1 encoding /and/ need end-of-line conversion.")) + (:documentation "Abstract class for external formats which use the +UTF-32 encoding.")) -(defclass flexi-utf-32-le-format (external-format) +(defclass flexi-utf-32-le-format (flexi-utf-32-format) () (:documentation "Special class for external formats which use the UTF-32 encoding with little-endian byte ordering.")) (defclass flexi-cr-utf-32-le-format (flexi-cr-mixin flexi-utf-32-le-format) - () - (:documentation "Special class for external formats which use the -UTF-32 encoding with little-endian byte ordering /and/ need -end-of-line conversion.")) + ()) -(defclass flexi-utf-32-be-format (external-format) +(defclass flexi-crlf-utf-32-le-format (flexi-crlf-mixin flexi-utf-32-le-format) + ()) + +(defclass flexi-utf-32-be-format (flexi-utf-32-format) () (:documentation "Special class for external formats which use the UTF-32 encoding with big-endian byte ordering.")) (defclass flexi-cr-utf-32-be-format (flexi-cr-mixin flexi-utf-32-be-format) + ()) + +(defclass flexi-crlf-utf-32-be-format (flexi-crlf-mixin flexi-utf-32-be-format) + ()) + +(defclass flexi-utf-16-format (external-format) () - (:documentation "Special class for external formats which use the -UTF-32 encoding with big-endian byte ordering /and/ need end-of-line -conversion.")) + (:documentation "Abstract class for external formats which use the +UTF-16 encoding.")) -(defclass flexi-utf-16-le-format (external-format) +(defclass flexi-utf-16-le-format (flexi-utf-16-format) () (:documentation "Special class for external formats which use the UTF-16 encoding with little-endian byte ordering.")) (defclass flexi-cr-utf-16-le-format (flexi-cr-mixin flexi-utf-16-le-format) - () - (:documentation "Special class for external formats which use the -UTF-16 encoding with little-endian byte ordering /and/ need -end-of-line conversion.")) + ()) -(defclass flexi-utf-16-be-format (external-format) +(defclass flexi-crlf-utf-16-le-format (flexi-crlf-mixin flexi-utf-16-le-format) + ()) + +(defclass flexi-utf-16-be-format (flexi-utf-16-format) () (:documentation "Special class for external formats which use the UTF-16 encoding with big-endian byte ordering.")) (defclass flexi-cr-utf-16-be-format (flexi-cr-mixin flexi-utf-16-be-format) - () - (:documentation "Special class for external formats which use the -UTF-16 encoding with big-endian byte ordering /and/ need end-of-line -conversion.")) + ()) + +(defclass flexi-crlf-utf-16-be-format (flexi-crlf-mixin flexi-utf-16-be-format) + ()) (defclass flexi-utf-8-format (external-format) () @@ -146,9 +163,10 @@ UTF-8 encoding.")) (defclass flexi-cr-utf-8-format (flexi-cr-mixin flexi-utf-8-format) - () - (:documentation "Special class for external formats which use the -UTF-8 encoding /and/ need end-of-line conversion.")) + ()) + +(defclass flexi-crlf-utf-8-format (flexi-crlf-mixin flexi-utf-8-format) + ()) (defmethod initialize-instance :after ((external-format flexi-8-bit-format) &rest initargs) "Sets the fixed encoding/decoding tables for this particular @@ -171,40 +189,50 @@ (values (cdr (assoc id +code-page-hashes+)) (cdr (assoc id +code-page-tables+)))))))) -(defun external-format-class-name (real-name eol-style little-endian) - (let ((crp (not (eq eol-style :lf)))) - (cond ((ascii-name-p real-name) - (if crp - 'flexi-cr-ascii-format - 'flexi-ascii-format)) - ((eq real-name :iso-8859-1) - (if crp - 'flexi-cr-latin-1-format - 'flexi-latin-1-format)) - ((or (koi8-r-name-p real-name) - (iso-8859-name-p real-name) - (code-page-name-p real-name)) - (if crp - 'flexi-cr-8-bit-format - 'flexi-8-bit-format)) - (t (case real-name - (:utf-8 (if crp - 'flexi-cr-utf-8-format - 'flexi-utf-8-format)) - (:utf-16 (if crp - (if little-endian - 'flexi-cr-utf-16-le-format - 'flexi-cr-utf-16-be-format) - (if little-endian - 'flexi-utf-16-le-format - 'flexi-utf-16-be-format))) - (:utf-32 (if crp - (if little-endian - 'flexi-cr-utf-32-le-format - 'flexi-cr-utf-32-be-format) - (if little-endian - 'flexi-utf-32-le-format - 'flexi-utf-32-be-format)))))))) +(defun external-format-class-name (real-name &key eol-style little-endian id) + (declare (ignore id)) + (cond ((ascii-name-p real-name) + (ecase eol-style + (:lf 'flexi-ascii-format) + (:cr 'flexi-cr-ascii-format) + (:crlf 'flexi-crlf-ascii-format))) + ((eq real-name :iso-8859-1) + (ecase eol-style + (:lf 'flexi-latin-1-format) + (:cr 'flexi-cr-latin-1-format) + (:crlf 'flexi-crlf-latin-1-format))) + ((or (koi8-r-name-p real-name) + (iso-8859-name-p real-name) + (code-page-name-p real-name)) + (ecase eol-style + (:lf 'flexi-8-bit-format) + (:cr 'flexi-cr-8-bit-format) + (:crlf 'flexi-crlf-8-bit-format))) + (t (ecase real-name + (:utf-8 (ecase eol-style + (:lf 'flexi-utf-8-format) + (:cr 'flexi-cr-utf-8-format) + (:crlf 'flexi-crlf-utf-8-format))) + (:utf-16 (ecase eol-style + (:lf (if little-endian + 'flexi-utf-16-le-format + 'flexi-utf-16-be-format)) + (:cr (if little-endian + 'flexi-cr-utf-16-le-format + 'flexi-cr-utf-16-be-format)) + (:crlf (if little-endian + 'flexi-crlf-utf-16-le-format + 'flexi-crlf-utf-16-be-format)))) + (:utf-32 (ecase eol-style + (:lf (if little-endian + 'flexi-utf-32-le-format + 'flexi-utf-32-be-format)) + (:cr (if little-endian + 'flexi-cr-utf-32-le-format + 'flexi-cr-utf-32-be-format)) + (:crlf (if little-endian + 'flexi-crlf-utf-32-le-format + 'flexi-crlf-utf-32-be-format)))))))) (defun make-external-format% (name &key (little-endian *default-little-endian*) id eol-style) @@ -222,7 +250,7 @@ :eol-style (or eol-style :crlf))) (t (list :eol-style (or eol-style *default-eol-style*) :little-endian little-endian))))) - (apply #'make-instance (external-format-class-name real-name eol-style little-endian) + (apply #'make-instance (apply #'external-format-class-name real-name initargs) :name real-name initargs))) @@ -242,6 +270,15 @@ (append shortcut-args `(:eol-style ,eol-style)))) (t (apply #'make-external-format% name args))))) + +(defun maybe-convert-external-format (external-format) + "Given an external format designator \(a keyword, a list, or an +EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT +object." + (typecase external-format + (symbol (make-external-format external-format)) + (list (apply #'make-external-format external-format)) + (otherwise external-format))) (defun external-format-equal (ef1 ef2) "Checks whether two EXTERNAL-FORMAT objects denote the same @@ -292,4 +329,21 @@ "How an EXTERNAL-FORMAT object is rendered. Uses NORMALIZE-EXTERNAL-FORMAT." (print-unreadable-object (object stream :type t :identity t) - (prin1 (normalize-external-format object) stream))) \ No newline at end of file + (prin1 (normalize-external-format object) stream))) + +(defgeneric encoding-factor (format)) + +(defmethod encoding-factor ((format flexi-8-bit-format)) + 1) + +(defmethod encoding-factor ((format flexi-utf-8-format)) + 1.05) + +(defmethod encoding-factor ((format flexi-utf-16-format)) + 2.0) + +(defmethod encoding-factor ((format flexi-utf-32-format)) + 4) + +(defmethod encoding-factor ((format flexi-crlf-mixin)) + (* 1.02 (call-next-method))) \ No newline at end of file Modified: branches/edi/specials.lisp ============================================================================== --- branches/edi/specials.lisp (original) +++ branches/edi/specials.lisp Sat May 17 21:23:53 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.26 2008/05/17 13:50:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.27 2008/05/18 01:21:34 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -33,6 +33,12 @@ "A shortcut for \(UNSIGNED-BYTE 8)." '(unsigned-byte 8)) +(deftype char* () + "Convenience shortcut to paper over the difference between LispWorks +and the other Lisps." + #+:lispworks 'lw:simple-char + #-:lispworks 'character) + (defvar +name-map+ '((:utf8 . :utf-8) (:utf16 . :utf-16) Modified: branches/edi/stream.lisp ============================================================================== --- branches/edi/stream.lisp (original) +++ branches/edi/stream.lisp Sat May 17 21:23:53 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.57 2008/05/17 14:21:20 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.59 2008/05/18 01:21:34 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -40,7 +40,7 @@ :accessor flexi-stream-external-format :documentation "The encoding currently used by this stream. Can be changed on the fly.") - (element-type :initform #+:lispworks 'lw:simple-char #-:lispworks 'character + (element-type :initform 'char* :initarg :element-type :accessor flexi-stream-element-type :documentation "The element type of this stream.")) @@ -49,15 +49,6 @@ allow for multi-octet external formats. FLEXI-STREAM itself is a mixin and should not be instantiated.")) -(defun maybe-convert-external-format (external-format) - "Given an external format designator \(a keyword, a list, or an -EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT -object." - (typecase external-format - (symbol (make-external-format external-format)) - (list (apply #'make-external-format external-format)) - (otherwise external-format))) - (defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs) "Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain reasonable values." Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Sat May 17 21:23:53 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.5 2008/05/17 13:50:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.8 2008/05/18 01:21:34 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -29,28 +29,80 @@ (in-package :flexi-streams) -(defun string-to-octets (string &key (external-format (make-external-format :latin1)) - (start 0) end) +(defun string-to-octets (string &key + (external-format (make-external-format :latin1)) + (start 0) (end (length string))) "Converts the Lisp string STRING from START to END to an array of octets corresponding to the external format EXTERNAL-FORMAT." - (declare (optimize speed)) - (with-output-to-sequence (out) - (let ((flexi (make-flexi-stream out :external-format external-format))) - (write-string string flexi :start start :end end)))) - -(defun octets-to-string (vector &key (external-format (make-external-format :latin1)) - (start 0) (end (length vector))) + (setq external-format (maybe-convert-external-format external-format)) + (let ((factor (encoding-factor external-format)) + (length (- end start))) + (etypecase factor + (float + (let ((octets (make-array (round (* factor length)) + :element-type 'octet + :fill-pointer 0 + :adjustable t))) + (loop for i from start below end + do (char-to-octets external-format + (char string i) + (lambda (octet) + (vector-push-extend octet octets)) + nil)) + octets)) + (integer + (let ((octets (make-array (* factor length) + :element-type 'octet))) + (loop with j = 0 + for i from start below end + do (char-to-octets external-format + (char string i) + (lambda (octet) + (setf (aref octets j) octet) + (incf j)) + nil)) + octets))))) + +(defun octets-to-string (vector &key + (external-format (make-external-format :latin1)) + (start 0) (end (length vector))) "Converts the Lisp vector VECTOR of octets from START to END to string using the external format EXTERNAL-FORMAT." - (declare (optimize speed)) - (with-input-from-sequence (in vector :start start :end end) - (let ((flexi (make-flexi-stream in :external-format external-format)) - (result (make-array (- end start) - :element-type #+:lispworks 'lw:simple-char - #-:lispworks 'character - :fill-pointer t))) - (setf (fill-pointer result) - (read-sequence result flexi)) - result))) - - + (setq external-format (maybe-convert-external-format external-format)) + (let ((factor (encoding-factor external-format)) + (length (- end start)) + (i start)) + (flet ((next-char () + (code-char + (octets-to-char-code external-format + (lambda () + (when (>= i end) + ;; TODO... + (error "End of data.")) + (prog1 + (aref vector i) + (incf i))) + (lambda (char) + (char-to-octets external-format + char + (lambda (octet) + (declare (ignore octet)) + (decf i)) + nil)) + nil)))) + (etypecase factor + (float + (let ((string (make-array (round (/ length factor)) + :element-type 'char* + :fill-pointer 0 + :adjustable t))) + (loop while (< i end) + do (vector-push-extend (next-char) string) + finally (return string)))) + (integer + (let* ((string-length (/ length factor)) + (string (make-array string-length + :element-type 'char*))) + (loop for j from 0 below string-length + do (setf (char string j) (next-char)) + finally (return string)))))))) Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Sat May 17 21:23:53 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.20 2008/05/17 13:50:18 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.21 2008/05/18 01:21:36 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -263,12 +263,10 @@ that the stream conversion functions work." (let* ((full-path (merge-pathnames pathspec *this-file*)) (octets-vector (file-as-octet-vector full-path)) - (octets-list (coerce octets-vector 'list)) (string (file-as-string full-path external-format))) (with-test ((format nil "String tests with format ~S." (flex::normalize-external-format external-format))) (check (string= (octets-to-string octets-vector :external-format external-format) string)) - (check (string= (octets-to-string octets-list :external-format external-format) string)) (check (equalp (string-to-octets string :external-format external-format) octets-vector))))) (defmacro using-values ((&rest values) &body body)

1 0

[flexi-streams-cvs] r26 - branches/edi
by eweitz＠common-lisp.net 18 May '08

18 May '08

Author: eweitz Date: Sat May 17 20:33:30 2008 New Revision: 26 Added: branches/edi/decode.lisp - copied unchanged from r25, branches/edi/decode.lisp.temp Removed: branches/edi/decode.lisp.temp Log: Cleaning up wrong names, part 3

1 0

[flexi-streams-cvs] r25 - branches/edi
by eweitz＠common-lisp.net 18 May '08

18 May '08

Author: eweitz Date: Sat May 17 20:33:05 2008 New Revision: 25 Added: branches/edi/encode.lisp - copied unchanged from r24, branches/edi/decode.lisp Removed: branches/edi/decode.lisp Log: Cleaning up wrong names, part 2

1 0

[flexi-streams-cvs] r24 - branches/edi
by eweitz＠common-lisp.net 18 May '08

18 May '08

Author: eweitz Date: Sat May 17 20:32:41 2008 New Revision: 24 Added: branches/edi/decode.lisp.temp - copied unchanged from r23, branches/edi/encode.lisp Removed: branches/edi/encode.lisp Log: Cleaning up wrong names

1 0

[flexi-streams-cvs] r23 - in branches/edi: . test
by eweitz＠common-lisp.net 17 May '08

17 May '08

Author: eweitz Date: Sat May 17 18:31:08 2008 New Revision: 23 Added: branches/edi/conditions.lisp (contents, props changed) branches/edi/decode.lisp (contents, props changed) branches/edi/encode.lisp (contents, props changed) Modified: branches/edi/ascii.lisp branches/edi/code-pages.lisp branches/edi/external-format.lisp branches/edi/flexi-streams.asd branches/edi/in-memory.lisp branches/edi/input.lisp branches/edi/iso-8859.lisp branches/edi/lw-binary-stream.lisp branches/edi/output.lisp branches/edi/packages.lisp branches/edi/specials.lisp branches/edi/stream.lisp branches/edi/strings.lisp branches/edi/test/packages.lisp branches/edi/test/test.lisp branches/edi/util.lisp Log: Start of reorg - this time as a diff from trunk Modified: branches/edi/ascii.lisp ============================================================================== --- branches/edi/ascii.lisp (original) +++ branches/edi/ascii.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/ascii.lisp,v 1.7 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/ascii.lisp,v 1.8 2008/05/17 13:50:15 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: branches/edi/code-pages.lisp ============================================================================== --- branches/edi/code-pages.lisp (original) +++ branches/edi/code-pages.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/code-pages.lisp,v 1.5 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/code-pages.lisp,v 1.6 2008/05/17 13:50:15 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Added: branches/edi/conditions.lisp ============================================================================== --- (empty file) +++ branches/edi/conditions.lisp Sat May 17 18:31:08 2008 @@ -0,0 +1,84 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.3 2008/05/17 15:56:16 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(define-condition flexi-stream-error (stream-error) + () + (:documentation "Superclass for all errors related to +flexi streams.")) + +(define-condition flexi-stream-simple-error (flexi-stream-error simple-condition) + () + (:documentation "Like FLEXI-STREAM-ERROR but with formatting +capabilities.")) + +(define-condition flexi-stream-element-type-error (flexi-stream-error) + ((element-type :initarg :element-type + :reader flexi-stream-element-type-error-element-type)) + (:report (lambda (condition stream) + (format stream "Element type ~S not allowed." + (flexi-stream-element-type-error-element-type condition)))) + (:documentation "Errors of this type are signalled if the flexi +stream has a wrong element type.")) + +(define-condition flexi-stream-encoding-error (flexi-stream-simple-error) + () + (:documentation "Errors of this type are signalled if there is an +encoding problem.")) + +(define-condition flexi-stream-position-spec-error (flexi-stream-simple-error) + ((position-spec :initarg :position-spec + :reader flexi-stream-position-spec-error-position-spec)) + (:documentation "Errors of this type are signalled if an +erroneous position spec is used in conjunction with +FILE-POSITION.")) + +;; TODO: stream might not be a stream... +(defun signal-encoding-error (flexi-stream format-control &rest format-args) + "Convenience function similar to ERROR to signal conditions of type +FLEXI-STREAM-ENCODING-ERROR." + (error 'flexi-stream-encoding-error + :format-control format-control + :format-arguments format-args + :stream flexi-stream)) + +(define-condition in-memory-stream-error (stream-error) + () + (:documentation "Superclass for all errors related to +IN-MEMORY streams.")) + +(define-condition in-memory-stream-closed-error (in-memory-stream-error) + () + (:report (lambda (condition stream) + (format stream "~S is closed." + (stream-error-stream condition)))) + (:documentation "An error that is signalled when someone is trying +to read from or write to a closed IN-MEMORY stream.")) + Added: branches/edi/decode.lisp ============================================================================== --- (empty file) +++ branches/edi/decode.lisp Sat May 17 18:31:08 2008 @@ -0,0 +1,151 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.2 2008/05/17 16:35:58 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defgeneric char-to-octets (format char writer stream) + (:documentation "Converts the character CHAR to sequence of octets +and sends this sequence to SINK. STREAM will always be a flexi stream +which is used to determine how the character should be converted. +This function does all the work for STREAM-WRITE-CHAR in which case +SINK is the same as STREAM. It is also used in the implementation of +STREAM-WRITE-SEQUENCE below.")) + +(defmethod char-to-octets ((format flexi-latin-1-format) char writer stream) + (declare (optimize speed)) + (let ((octet (char-code char))) + (when (> octet 255) + (signal-encoding-error stream "~S is not a LATIN-1 character." char)) + (funcall writer octet)) + char) + +(defmethod char-to-octets ((format flexi-ascii-format) char writer stream) + (declare (optimize speed)) + (let ((octet (char-code char))) + (when (> octet 127) + (signal-encoding-error stream "~S is not an ASCII character." char)) + (funcall writer octet)) + char) + +(defmethod char-to-octets ((format flexi-8-bit-format) char writer stream) + (declare (optimize speed)) + (with-accessors ((encoding-hash external-format-encoding-hash)) + format + (let ((octet (gethash (char-code char) encoding-hash))) + (unless octet + (signal-encoding-error stream "~S is not in this encoding." char)) + (funcall writer octet)) + char)) + +(defmethod char-to-octets ((format flexi-utf-8-format) char writer stream) + (declare (ignore stream) (optimize speed)) + (let ((char-code (char-code char))) + (tagbody + (cond ((< char-code #x80) + (funcall writer char-code) + (go zero)) + ((< char-code #x800) + (funcall writer (logior #b11000000 (ldb (byte 5 6) char-code))) + (go one)) + ((< char-code #x10000) + (funcall writer (logior #b11100000 (ldb (byte 4 12) char-code))) + (go two)) + ((< char-code #x200000) + (funcall writer (logior #b11110000 (ldb (byte 3 18) char-code))) + (go three)) + ((< char-code #x4000000) + (funcall writer (logior #b11111000 (ldb (byte 2 24) char-code))) + (go four)) + (t (funcall writer (logior #b11111100 (ldb (byte 1 30) char-code))))) + (funcall writer (logior #b10000000 (ldb (byte 6 24) char-code))) + four + (funcall writer (logior #b10000000 (ldb (byte 6 18) char-code))) + three + (funcall writer (logior #b10000000 (ldb (byte 6 12) char-code))) + two + (funcall writer (logior #b10000000 (ldb (byte 6 6) char-code))) + one + (funcall writer (logior #b10000000 (ldb (byte 6 0) char-code))) + zero)) + char) + +(defmethod char-to-octets ((format flexi-utf-16-le-format) char writer stream) + (declare (ignore stream) (optimize speed)) + (flet ((write-word (word) + (funcall writer (ldb (byte 8 0) word)) + (funcall writer (ldb (byte 8 8) word)))) + (let ((char-code (char-code char))) + (cond ((< char-code #x10000) + (write-word char-code)) + (t (decf char-code #x10000) + (write-word (logior #xd800 (ldb (byte 10 10) char-code))) + (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) + char) + +(defmethod char-to-octets ((format flexi-utf-16-be-format) char writer stream) + (declare (ignore stream) (optimize speed)) + (flet ((write-word (word) + (funcall writer (ldb (byte 8 8) word)) + (funcall writer (ldb (byte 8 0) word)))) + (declare (inline write-word) (dynamic-extent (function write-word))) + (let ((char-code (char-code char))) + (cond ((< char-code #x10000) + (write-word char-code)) + (t (decf char-code #x10000) + (write-word (logior #xd800 (ldb (byte 10 10) char-code))) + (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) + char) + +(defmethod char-to-octets ((format flexi-utf-32-le-format) char writer stream) + (declare (ignore stream) (optimize speed)) + (loop with char-code = (char-code char) + for position in '(0 8 16 24) do + (funcall writer (ldb (byte 8 position) char-code))) + char) + +(defmethod char-to-octets ((format flexi-utf-32-be-format) char writer stream) + (declare (ignore stream) (optimize speed)) + (loop with char-code = (char-code char) + for position in '(24 16 8 0) do + (funcall writer (ldb (byte 8 position) char-code))) + char) + +(defmethod char-to-octets ((format flexi-cr-mixin) char writer stream) + "The `base' method for all formats which need end-of-line +conversion. Uses CALL-NEXT-METHOD to do the actual work of sending +one or more characters to SINK." + (declare (optimize speed)) + (case char + (#\Newline + (case (external-format-eol-style format) + (:cr (call-next-method format #\Return writer stream)) + (:crlf (call-next-method format #\Return writer stream) + (call-next-method format #\Linefeed writer stream)))) + (otherwise (call-next-method))) + char) Added: branches/edi/encode.lisp ============================================================================== --- (empty file) +++ branches/edi/encode.lisp Sat May 17 18:31:08 2008 @@ -0,0 +1,237 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.2 2008/05/17 16:35:58 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defun recover-from-encoding-error (stream format-control &rest format-args) + "Helper function used by the STREAM-READ-CHAR methods below to deal +with encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and +returns its character code in this case. Otherwise signals a +FLEXI-STREAM-ENCODING-ERROR as determined by the arguments to this +function and provides a corresponding USE-VALUE restart." + (when *substitution-char* + (return-from recover-from-encoding-error (char-code *substitution-char*))) + (restart-case + (apply #'signal-encoding-error stream format-control format-args) + (use-value (char) + :report "Specify a character to be used instead." + :interactive (lambda () + (loop + (format *query-io* "Type a character: ") + (let ((line (read-line *query-io*))) + (when (= 1 (length line)) + (return (list (char line 0))))))) + (char-code char)))) + +(defmethod octets-to-char-code ((format flexi-latin-1-format) reader unreader stream) + (declare (ignore unreader stream)) + (or (funcall reader) :eof)) + +(defmethod octets-to-char-code ((format flexi-ascii-format) reader unreader stream) + (declare (ignore unreader)) + (let ((octet (or (funcall reader) + (return-from octets-to-char-code :eof)))) + (declare (type octet octet)) + (if (> octet 127) + (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) + octet))) + +(defmethod octets-to-char-code ((format flexi-8-bit-format) reader unreader stream) + (declare (ignore unreader)) + (with-accessors ((decoding-table external-format-decoding-table)) + format + (let* ((octet (or (funcall reader) + (return-from octets-to-char-code :eof))) + (char-code (aref (the (simple-array * *) decoding-table) octet))) + (declare (type octet octet)) + (if (or (null char-code) + (= char-code 65533)) + (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) + char-code)))) + +(defmethod octets-to-char-code ((format flexi-utf-8-format) reader unreader stream) + (declare (ignore unreader)) + (let (first-octet-seen) + (flet ((read-next-byte () + (prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error stream + "End of file while in UTF-8 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) + (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) + (let ((octet (read-next-byte))) + (declare (type octet octet)) + (multiple-value-bind (start count) + (cond ((zerop (logand octet #b10000000)) + (values octet 0)) + ((= #b11000000 (logand octet #b11100000)) + (values (logand octet #b00011111) 1)) + ((= #b11100000 (logand octet #b11110000)) + (values (logand octet #b00001111) 2)) + ((= #b11110000 (logand octet #b11111000)) + (values (logand octet #b00000111) 3)) + ((= #b11111000 (logand octet #b11111100)) + (values (logand octet #b00000011) 4)) + ((= #b11111100 (logand octet #b11111110)) + (values (logand octet #b00000001) 5)) + (t (return-from octets-to-char-code + (recover-from-encoding-error stream + "Unexpected value #x~X at start of UTF-8 sequence." + octet)))) + ;; note that we currently don't check for "overlong" + ;; sequences or other illegal values + (loop for result of-type (unsigned-byte 32) + = start then (+ (ash result 6) + (logand octet #b111111)) + repeat count + for octet of-type octet = (read-next-byte) + unless (= #b10000000 (logand octet #b11000000)) + do (return-from octets-to-char-code + (recover-from-encoding-error stream + "Unexpected value #x~X in UTF-8 sequence." octet)) + finally (return result))))))) + +(defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader unreader stream) + (declare (ignore unreader)) + (let (first-octet-seen) + (labels ((read-next-byte () + (prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error stream + "End of file while in UTF-16 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t))) + (read-next-word () + (+ (the octet (read-next-byte)) + (ash (the octet (read-next-byte)) 8)))) + (declare (inline read-next-byte read-next-word) + (dynamic-extent (function read-next-byte) (function read-next-word))) + (let ((word (read-next-word))) + (cond ((<= #xd800 word #xdfff) + (let ((next-word (read-next-word))) + (unless (<= #xdc00 next-word #xdfff) + (return-from octets-to-char-code + (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) + (+ (ash (logand #b1111111111 word) 10) + (logand #b1111111111 next-word) + #x10000))) + (t word)))))) + +(defmethod octets-to-char-code ((format flexi-utf-16-be-format) reader unreader stream) + (declare (ignore unreader)) + (let (first-octet-seen) + (labels ((read-next-byte () + (prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error stream + "End of file while in UTF-16 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t))) + (read-next-word () + (+ (ash (the octet (read-next-byte)) 8) + (the octet (read-next-byte))))) + (let ((word (read-next-word))) + (cond ((<= #xd800 word #xdfff) + (let ((next-word (read-next-word))) + (unless (<= #xdc00 next-word #xdfff) + (return-from octets-to-char-code + (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) + (+ (ash (logand #b1111111111 word) 10) + (logand #b1111111111 next-word) + #x10000))) + (t word)))))) + +(defmethod octets-to-char-code ((format flexi-utf-32-le-format) reader unreader stream) + (let (first-octet-seen) + (flet ((read-next-byte () + (prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error stream + "End of file while in UTF-32 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) + (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) + (loop for count from 0 to 24 by 8 + for octet of-type octet = (read-next-byte) + sum (ash octet count))))) + +(defmethod octets-to-char-code ((format flexi-utf-32-be-format) reader unreader stream) + (declare (ignore unreader)) + (let (first-octet-seen) + (flet ((read-next-byte () + (prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error stream + "End of file while in UTF-32 sequence."))) + (t (return-from octets-to-char-code :eof)))) + (setq first-octet-seen t)))) + (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) + (loop for count from 24 downto 0 by 8 + for octet of-type octet = (read-next-byte) + sum (ash octet count))))) + +(defmethod octets-to-char-code ((format flexi-cr-mixin) reader unreader stream) + "The `base' method for all streams which need end-of-line +conversion. Uses CALL-NEXT-METHOD to do the actual work of reading +one or more encoded characters." + (declare (optimize speed)) + (let ((char-code (call-next-method))) + (when (eq char-code :eof) + (return-from octets-to-char-code :eof)) + (with-accessors ((eol-style external-format-eol-style)) + format + (cond ((= char-code #.(char-code #\Return)) + (case eol-style + (:cr #.(char-code #\Newline)) + ;; in the case :CRLF we have to look ahead one character + (:crlf (let ((next-char-code (call-next-method))) + (case next-char-code + (#.(char-code #\Linefeed) + #.(char-code #\Newline)) + (:eof char-code) + ;; if the character we peeked at wasn't a + ;; linefeed character we unread its constituents + (otherwise + (funcall unreader (code-char next-char-code)) + char-code)))))) + (t char-code))))) + Modified: branches/edi/external-format.lisp ============================================================================== --- branches/edi/external-format.lisp (original) +++ branches/edi/external-format.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.11 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.15 2008/05/17 16:38:24 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -58,6 +58,154 @@ "Defines a way to reconstruct external formats. Needed for OpenMCL." (make-load-form-saving-slots thing :environment environment)) +(defclass flexi-cr-mixin () + () + (:documentation "A mixin for external-formats which need +end-of-line conversion, i.e. for those where the end-of-line +designator is /not/ the single character #\Linefeed.")) + +(defclass flexi-8-bit-format (external-format) + ((encoding-hash :accessor external-format-encoding-hash) + (decoding-table :accessor external-format-decoding-table)) + (:documentation "The class for all flexi streams which use an 8-bit +encoding and thus need additional slots for the encoding/decoding +tables.")) + +(defclass flexi-cr-8-bit-format (flexi-cr-mixin flexi-8-bit-format) + () + (:documentation "The class for all external formats which use an +8-bit encoding /and/ need end-of-line conversion.")) + +(defclass flexi-ascii-format (flexi-8-bit-format) + () + (:documentation "Special class for external formats which use the +US-ASCCI encoding.")) + +(defclass flexi-cr-ascii-format (flexi-cr-mixin flexi-ascii-format) + () + (:documentation "Special class for external formats which use the +US-ASCCI encoding /and/ need end-of-line conversion.")) + +(defclass flexi-latin-1-format (flexi-8-bit-format) + () + (:documentation "Special class for external formats which use the +ISO-8859-1 encoding.")) + +(defclass flexi-cr-latin-1-format (flexi-cr-mixin flexi-latin-1-format) + () + (:documentation "Special class for external formats which use the +ISO-8859-1 encoding /and/ need end-of-line conversion.")) + +(defclass flexi-utf-32-le-format (external-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with little-endian byte ordering.")) + +(defclass flexi-cr-utf-32-le-format (flexi-cr-mixin flexi-utf-32-le-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with little-endian byte ordering /and/ need +end-of-line conversion.")) + +(defclass flexi-utf-32-be-format (external-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with big-endian byte ordering.")) + +(defclass flexi-cr-utf-32-be-format (flexi-cr-mixin flexi-utf-32-be-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with big-endian byte ordering /and/ need end-of-line +conversion.")) + +(defclass flexi-utf-16-le-format (external-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with little-endian byte ordering.")) + +(defclass flexi-cr-utf-16-le-format (flexi-cr-mixin flexi-utf-16-le-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with little-endian byte ordering /and/ need +end-of-line conversion.")) + +(defclass flexi-utf-16-be-format (external-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with big-endian byte ordering.")) + +(defclass flexi-cr-utf-16-be-format (flexi-cr-mixin flexi-utf-16-be-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with big-endian byte ordering /and/ need end-of-line +conversion.")) + +(defclass flexi-utf-8-format (external-format) + () + (:documentation "Special class for external formats which use the +UTF-8 encoding.")) + +(defclass flexi-cr-utf-8-format (flexi-cr-mixin flexi-utf-8-format) + () + (:documentation "Special class for external formats which use the +UTF-8 encoding /and/ need end-of-line conversion.")) + +(defmethod initialize-instance :after ((external-format flexi-8-bit-format) &rest initargs) + "Sets the fixed encoding/decoding tables for this particular +external format." + (declare (ignore initargs)) + (with-accessors ((encoding-hash external-format-encoding-hash) + (decoding-table flexi-stream-decoding-table) + (name external-format-name) + (id external-format-id)) + external-format + (multiple-value-setq (encoding-hash decoding-table) + (cond ((ascii-name-p name) + (values +ascii-hash+ +ascii-table+)) + ((koi8-r-name-p name) + (values +koi8-r-hash+ +koi8-r-table+)) + ((iso-8859-name-p name) + (values (cdr (assoc name +iso-8859-hashes+ :test #'eq)) + (cdr (assoc name +iso-8859-tables+ :test #'eq)))) + ((code-page-name-p name) + (values (cdr (assoc id +code-page-hashes+)) + (cdr (assoc id +code-page-tables+)))))))) + +(defun external-format-class-name (real-name eol-style little-endian) + (let ((crp (not (eq eol-style :lf)))) + (cond ((ascii-name-p real-name) + (if crp + 'flexi-cr-ascii-format + 'flexi-ascii-format)) + ((eq real-name :iso-8859-1) + (if crp + 'flexi-cr-latin-1-format + 'flexi-latin-1-format)) + ((or (koi8-r-name-p real-name) + (iso-8859-name-p real-name) + (code-page-name-p real-name)) + (if crp + 'flexi-cr-8-bit-format + 'flexi-8-bit-format)) + (t (case real-name + (:utf-8 (if crp + 'flexi-cr-utf-8-format + 'flexi-utf-8-format)) + (:utf-16 (if crp + (if little-endian + 'flexi-cr-utf-16-le-format + 'flexi-cr-utf-16-be-format) + (if little-endian + 'flexi-utf-16-le-format + 'flexi-utf-16-be-format))) + (:utf-32 (if crp + (if little-endian + 'flexi-cr-utf-32-le-format + 'flexi-cr-utf-32-be-format) + (if little-endian + 'flexi-utf-32-le-format + 'flexi-utf-32-be-format)))))))) + (defun make-external-format% (name &key (little-endian *default-little-endian*) id eol-style) "Used internally by MAKE-EXTERNAL-FORMAT." @@ -74,7 +222,7 @@ :eol-style (or eol-style :crlf))) (t (list :eol-style (or eol-style *default-eol-style*) :little-endian little-endian))))) - (apply #'make-instance 'external-format + (apply #'make-instance (external-format-class-name real-name eol-style little-endian) :name real-name initargs))) Modified: branches/edi/flexi-streams.asd ============================================================================== --- branches/edi/flexi-streams.asd (original) +++ branches/edi/flexi-streams.asd Sat May 17 18:31:08 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.58 2007/12/29 23:15:26 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.60 2008/05/17 15:56:16 edi Exp $ ;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. @@ -45,7 +45,10 @@ (:file "specials") (:file "util") (:file "external-format") + (:file "encode") + (:file "decode") (:file "in-memory") + (:file "conditions") (:file "stream") #+:lispworks (:file "lw-binary-stream") (:file "output") Modified: branches/edi/in-memory.lisp ============================================================================== --- branches/edi/in-memory.lisp (original) +++ branches/edi/in-memory.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.26 2007/12/29 21:17:05 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.29 2008/05/17 16:35:58 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -104,19 +104,6 @@ (:documentation "A binary output stream that writes its data to an associated vector.")) -(define-condition in-memory-stream-error (stream-error) - () - (:documentation "Superclass for all errors related to -IN-MEMORY streams.")) - -(define-condition in-memory-stream-closed-error (in-memory-stream-error) - () - (:report (lambda (condition stream) - (format stream "~S is closed." - (stream-error-stream condition)))) - (:documentation "An error that is signalled when someone is trying -to read from or write to a closed IN-MEMORY stream.")) - #+:cmu (defmethod open-stream-p ((stream in-memory-stream)) "Returns a true value if STREAM is open. See ANSI standard." @@ -382,14 +369,3 @@ ,@body (get-output-stream-sequence ,var :as-list ,as-list)) (when ,var (close ,var))))) - -(declaim (inline translate-char)) -(defun translate-char (char-code external-format) - "Returns a list of octets which correspond to the -representation of the character with character code CHAR-CODE -when sent to a flexi stream with external format EXTERNAL-FORMAT. -Used internally by UNREAD-CHAR%. See also STRING-TO-OCTETS." - (declare (optimize speed)) - (with-output-to-sequence (list :as-list t) - (let ((stream (make-flexi-stream list :external-format external-format))) - (write-char (code-char char-code) stream)))) \ No newline at end of file Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.51 2007/12/29 22:58:43 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.57 2008/05/17 16:44:53 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -140,344 +140,47 @@ (setq last-octet octet) (or octet :eof)))) -(defgeneric unread-char% (char-code flexi-input-stream) - (:documentation "Used internally to put a character denoted by the -character code CHAR-CODE which was already read back on the stream. -Uses the OCTET-STACK slot and decrements the POSITION slot -accordingly.")) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-input-stream)) - "The default method which is un-optimized and uses TRANSLATE-CHAR to -figure out which octets to put on the octet stack." - (declare (optimize speed) (inline translate-char)) +(defun unread-char% (char flexi-input-stream) + "Used internally to put a character CHAR which was already read back +on the stream. Uses the OCTET-STACK slot and decrements the POSITION +slot accordingly." (with-accessors ((position flexi-stream-position) (octet-stack flexi-stream-octet-stack) (external-format flexi-stream-external-format)) flexi-input-stream - (declare (integer position)) - (let ((octets-read (translate-char char-code external-format))) - (decf position (length octets-read)) - (setq octet-stack (append octets-read octet-stack))))) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-latin-1-input-stream)) - "For ISO-8859-1 we can simply put the character code itself on the -octet stack." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack)) - flexi-input-stream - (declare (integer position)) - (decf position) - (push char-code octet-stack))) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-ascii-input-stream)) - "For ASCII we can simply put the character code itself on the octet -stack." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack)) - flexi-input-stream - (declare (integer position)) - (decf position) - (push char-code octet-stack))) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-8-bit-input-stream)) - "For 8-bit encodings we just have to put one octet on the octet -stack which we can look up in the encoding hash." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack) - (encoding-hash flexi-stream-encoding-hash)) - flexi-input-stream - (declare (integer position)) - (decf position) - (push (gethash char-code encoding-hash) octet-stack))) - -(defmethod unread-char% ((char-code (eql #.(char-code #\Newline))) - (flexi-input-stream flexi-cr-8-bit-input-stream)) - "A kind of `safety net' for the optimized 8-bit versions of -UNREAD-CHAR% which checks for the single case where more than one -octet has to be put on the octet stack." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack) - (external-format flexi-stream-external-format)) - flexi-input-stream - (declare (integer position)) - ;; note that below we use the knowledge that in all 8-bit encodings - ;; #\Return and #\Linefeed are mapped to the same octets - (case (external-format-eol-style external-format) - (:crlf - (decf position 2) - (push #.(char-code #\Linefeed) octet-stack) - (push #.(char-code #\Return) octet-stack)) - (otherwise - (decf position) - (push #.(char-code #\Return) octet-stack))))) - -#+:lispworks -(defmethod unread-char% ((char-code (eql #.(char-code #\Newline))) - (flexi-input-stream flexi-binary-cr-8-bit-input-stream)) - "A kind of `safety net' for the optimized 8-bit versions of -UNREAD-CHAR% which checks for the single case where more than one -octet has to be put on the octet stack. - -This method \(identical to the one defined directly above) exists only -for LispWorks' \"binary\" streams and must be there due to the -slightly clunky class hierarchy." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack) - (external-format flexi-stream-external-format)) - flexi-input-stream - (declare (integer position)) - ;; note that below we use the knowledge that in all 8-bit encodings - ;; #\Return and #\Linefeed are mapped to the same octets - (case (external-format-eol-style external-format) - (:crlf - (decf position 2) - (push #.(char-code #\Linefeed) octet-stack) - (push #.(char-code #\Return) octet-stack)) - (otherwise - (decf position) - (push #.(char-code #\Return) octet-stack))))) - -(defmacro define-char-reader ((stream-var stream-class) &body body) - "Helper macro to define methods for STREAM-READ-CHAR. Defines a -method for the class STREAM-CLASS using the variable STREAM-VAR and -the code body BODY wrapped with some standard code common to all -methods defined here. The return value of BODY is a character code. -In case of encoding problems, BODY must return the value returned by -\(RECOVER-FROM-ENCODING-ERROR ...)." - (with-unique-names (char-code body-fn) - `(defmethod stream-read-char ((,stream-var ,stream-class)) - "This method was generated with the DEFINE-CHAR-READER macro." - (declare (optimize speed)) - ;; note that we do nothing for the :LF EOL style because we - ;; assume that #\Newline is the same as #\Linefeed in all - ;; Lisps which will use this library - (with-accessors ((last-octet flexi-stream-last-octet) - (last-char-code flexi-stream-last-char-code)) - ,stream-var - ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after - ;; this operation - (setq last-octet nil) - (let ((,char-code - (flet ((,body-fn () ,@body)) - (declare (inline ,body-fn) (dynamic-extent (function ,body-fn))) - (,body-fn)))) - ;; remember this character and the current external format - ;; for UNREAD-CHAR - (setq last-char-code ,char-code) - (or (code-char ,char-code) ,char-code)))))) - -(defun recover-from-encoding-error (flexi-stream format-control &rest format-args) - "Helper function used by the STREAM-READ-CHAR methods below to deal -with encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and -returns its character code in this case. Otherwise signals a -FLEXI-STREAM-ENCODING-ERROR as determined by the arguments to this -function and provides a corresponding USE-VALUE restart." - (when *substitution-char* - (return-from recover-from-encoding-error (char-code *substitution-char*))) - (restart-case - (apply #'signal-encoding-error flexi-stream format-control format-args) - (use-value (char) - :report "Specify a character to be used instead." - :interactive (lambda () - (loop - (format *query-io* "Type a character: ") - (let ((line (read-line *query-io*))) - (when (= 1 (length line)) - (return (list (char line 0))))))) - (char-code char)))) - -(define-char-reader (stream flexi-latin-1-input-stream) - (or (read-byte* stream) - (return-from stream-read-char :eof))) - -(define-char-reader (stream flexi-ascii-input-stream) - (let ((octet (or (read-byte* stream) - (return-from stream-read-char :eof)))) - (declare (type octet octet)) - (if (> octet 127) - (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) - octet))) - -(define-char-reader (stream flexi-8-bit-input-stream) - (with-accessors ((encoding-table flexi-stream-encoding-table)) + (let ((counter 0) octets-reversed) + (declare (integer position) + (fixnum counter)) + (char-to-octets external-format + char + (lambda (octet) + (incf counter) + (push octet octets-reversed)) + nil) + (decf position counter) + (setq octet-stack (nreconc octets-reversed octet-stack))))) + +(defmethod stream-read-char ((stream flexi-input-stream)) + (declare (optimize speed)) + ;; note that we do nothing for the :LF EOL style because we assume + ;; that #\Newline is the same as #\Linefeed in all Lisps which will + ;; use this library + (with-accessors ((external-format flexi-stream-external-format) + (last-octet flexi-stream-last-octet) + (last-char-code flexi-stream-last-char-code)) stream - (let* ((octet (or (read-byte* stream) - (return-from stream-read-char :eof))) - (char-code (aref (the (simple-array * *) encoding-table) octet))) - (declare (type octet octet)) - (if (or (null char-code) - (= char-code 65533)) - (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) - char-code)))) - -(define-char-reader (stream flexi-utf-8-input-stream) - (block body - (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-8 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (let ((octet (read-next-byte))) - (declare (type octet octet)) - (multiple-value-bind (start count) - (cond ((zerop (logand octet #b10000000)) - (values octet 0)) - ((= #b11000000 (logand octet #b11100000)) - (values (logand octet #b00011111) 1)) - ((= #b11100000 (logand octet #b11110000)) - (values (logand octet #b00001111) 2)) - ((= #b11110000 (logand octet #b11111000)) - (values (logand octet #b00000111) 3)) - ((= #b11111000 (logand octet #b11111100)) - (values (logand octet #b00000011) 4)) - ((= #b11111100 (logand octet #b11111110)) - (values (logand octet #b00000001) 5)) - (t (return-from body - (recover-from-encoding-error stream - "Unexpected value #x~X at start of UTF-8 sequence." - octet)))) - ;; note that we currently don't check for "overlong" - ;; sequences or other illegal values - (loop for result of-type (unsigned-byte 32) - = start then (+ (ash result 6) - (logand octet #b111111)) - repeat count - for octet of-type octet = (read-next-byte) - unless (= #b10000000 (logand octet #b11000000)) - do (return-from body - (recover-from-encoding-error stream - "Unexpected value #x~X in UTF-8 sequence." octet)) - finally (return result)))))))) - -(define-char-reader (stream flexi-utf-16-le-input-stream) - (block body - (let (first-octet-seen) - (labels ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-16 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t))) - (read-next-word () - (+ (the octet (read-next-byte)) - (ash (the octet (read-next-byte)) 8)))) - (declare (inline read-next-byte read-next-word) - (dynamic-extent (function read-next-byte) (function read-next-word))) - (let ((word (read-next-word))) - (cond ((<= #xd800 word #xdfff) - (let ((next-word (read-next-word))) - (unless (<= #xdc00 next-word #xdfff) - (return-from body - (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." - next-word word))) - (+ (ash (logand #b1111111111 word) 10) - (logand #b1111111111 next-word) - #x10000))) - (t word))))))) - -(define-char-reader (stream flexi-utf-16-be-input-stream) - (block body - (let (first-octet-seen) - (labels ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-16 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t))) - (read-next-word () - (+ (ash (the octet (read-next-byte)) 8) - (the octet (read-next-byte))))) - (let ((word (read-next-word))) - (cond ((<= #xd800 word #xdfff) - (let ((next-word (read-next-word))) - (unless (<= #xdc00 next-word #xdfff) - (return-from body - (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." - next-word word))) - (+ (ash (logand #b1111111111 word) 10) - (logand #b1111111111 next-word) - #x10000))) - (t word))))))) - -(define-char-reader (stream flexi-utf-32-le-input-stream) - (block body - (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-32 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (loop for count from 0 to 24 by 8 - for octet of-type octet = (read-next-byte) - sum (ash octet count)))))) - -(define-char-reader (stream flexi-utf-32-be-input-stream) - (block body - (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-32 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (loop for count from 24 downto 0 by 8 - for octet of-type octet = (read-next-byte) - sum (ash octet count)))))) - -(defmethod stream-read-char ((stream flexi-cr-mixin)) - "The `base' method for all streams which need end-of-line -conversion. Uses CALL-NEXT-METHOD to do the actual work of -reading one or more characters from the stream." - (declare (optimize speed)) - (let ((char (call-next-method))) - (when (eq char :eof) - (return-from stream-read-char :eof)) - (with-accessors ((external-format flexi-stream-external-format) - (last-char-code flexi-stream-last-char-code)) - stream - (when (eql char #\Return) - (case (external-format-eol-style external-format) - (:cr (setq char #\Newline - last-char-code #.(char-code #\Newline))) - ;; in the case :CRLF we have to look ahead one character - (:crlf (let ((next-char (call-next-method))) - (case next-char - (#\Linefeed - (setq char #\Newline - last-char-code #.(char-code #\Newline))) - (:eof) - ;; if the character we peeked at wasn't a - ;; linefeed character we push its - ;; constituents back onto our internal - ;; octet stack - (otherwise (unread-char% (char-code next-char) stream))))))) - char))) + ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after + ;; this operation + (setq last-octet nil) + (let ((char-code (octets-to-char-code external-format + (lambda () + (read-byte* stream)) + (lambda (char) + (unread-char% char stream)) + stream))) + ;; remember this character and its char code for UNREAD-CHAR + (setq last-char-code char-code) + (or (code-char char-code) char-code)))) (defmethod stream-read-char-no-hang ((stream flexi-input-stream)) "Reads one character if the underlying stream has at least one @@ -540,7 +243,7 @@ (error 'flexi-stream-simple-error :format-control "Last character read (~S) was different from ~S." :format-arguments (list (code-char last-char-code) char))) - (unread-char% last-char-code stream) + (unread-char% char stream) (setq last-char-code nil) nil)) Modified: branches/edi/iso-8859.lisp ============================================================================== --- branches/edi/iso-8859.lisp (original) +++ branches/edi/iso-8859.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/iso-8859.lisp,v 1.5 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/iso-8859.lisp,v 1.6 2008/05/17 13:50:16 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: branches/edi/lw-binary-stream.lisp ============================================================================== --- branches/edi/lw-binary-stream.lisp (original) +++ branches/edi/lw-binary-stream.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.10 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.13 2008/05/17 14:21:20 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -286,131 +286,7 @@ (defclass flexi-binary-cr-utf-8-io-stream (flexi-cr-mixin flexi-binary-utf-8-io-stream) () (:documentation "Like FLEXI-CR-UTF-8-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defmethod set-class ((stream flexi-binary-input-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-binary-cr-ascii-input-stream - 'flexi-binary-ascii-input-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-binary-cr-latin-1-input-stream - 'flexi-binary-latin-1-input-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-binary-cr-8-bit-input-stream - 'flexi-binary-8-bit-input-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-binary-cr-utf-8-input-stream - 'flexi-binary-utf-8-input-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-16-le-input-stream - 'flexi-binary-cr-utf-16-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-16-le-input-stream - 'flexi-binary-utf-16-be-input-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-32-le-input-stream - 'flexi-binary-cr-utf-32-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-32-le-input-stream - 'flexi-binary-utf-32-be-input-stream)))))))))) - -(defmethod set-class ((stream flexi-binary-output-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-binary-cr-ascii-output-stream - 'flexi-binary-ascii-output-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-binary-cr-latin-1-output-stream - 'flexi-binary-latin-1-output-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-binary-cr-8-bit-output-stream - 'flexi-binary-8-bit-output-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-binary-cr-utf-8-output-stream - 'flexi-binary-utf-8-output-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-16-le-output-stream - 'flexi-binary-cr-utf-16-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-16-le-output-stream - 'flexi-binary-utf-16-be-output-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-32-le-output-stream - 'flexi-binary-cr-utf-32-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-32-le-output-stream - 'flexi-binary-utf-32-be-output-stream)))))))))) - -(defmethod set-class ((stream flexi-binary-io-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-binary-cr-ascii-io-stream - 'flexi-binary-ascii-io-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-binary-cr-latin-1-io-stream - 'flexi-binary-latin-1-io-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-binary-cr-8-bit-io-stream - 'flexi-binary-8-bit-io-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-binary-cr-utf-8-io-stream - 'flexi-binary-utf-8-io-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-16-le-io-stream - 'flexi-binary-cr-utf-16-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-16-le-io-stream - 'flexi-binary-utf-16-be-io-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-32-le-io-stream - 'flexi-binary-cr-utf-32-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-32-le-io-stream - 'flexi-binary-utf-32-be-io-stream)))))))))) - +optimized for LispWorks binary streams.")) (defmethod initialize-instance :after ((flexi-stream flexi-output-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. @@ -423,8 +299,7 @@ (change-class flexi-stream (typecase flexi-stream (flexi-io-stream 'flexi-binary-io-stream) - (otherwise 'flexi-binary-output-stream))) - (set-class flexi-stream)))) + (otherwise 'flexi-binary-output-stream)))))) (defmethod initialize-instance :after ((flexi-stream flexi-input-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. @@ -437,5 +312,4 @@ (change-class flexi-stream (typecase flexi-stream (flexi-io-stream 'flexi-binary-io-stream) - (otherwise 'flexi-binary-input-stream))) - (set-class flexi-stream)))) + (otherwise 'flexi-binary-input-stream)))))) Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.44 2007/12/29 22:23:23 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.47 2008/05/17 16:40:33 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -62,137 +62,15 @@ sink (write-byte byte stream))) -(defmethod write-byte* (byte (sink array)) - (declare (optimize speed)) - (vector-push byte sink)) - -(defgeneric char-to-octets (stream char sink) - (:documentation "Converts the character CHAR to sequence of octets -and sends this sequence to SINK. STREAM will always be a flexi stream -which is used to determine how the character should be converted. -This function does all the work for STREAM-WRITE-CHAR in which case -SINK is the same as STREAM. It is also used in the implementation of -STREAM-WRITE-SEQUENCE below.")) - (defmethod stream-write-char ((stream flexi-output-stream) char) (declare (optimize speed)) - (char-to-octets stream char stream)) - -(defmethod char-to-octets ((stream flexi-latin-1-output-stream) char sink) - (declare (optimize speed)) - (let ((octet (char-code char))) - (when (> octet 255) - (signal-encoding-error stream "~S is not a LATIN-1 character." char)) - (write-byte* octet sink)) - char) - -(defmethod char-to-octets ((stream flexi-ascii-output-stream) char sink) - (declare (optimize speed)) - (let ((octet (char-code char))) - (when (> octet 127) - (signal-encoding-error stream "~S is not an ASCII character." char)) - (write-byte* octet sink)) - char) - -(defmethod char-to-octets ((stream flexi-8-bit-output-stream) char sink) - (declare (optimize speed)) - (with-accessors ((encoding-hash flexi-stream-encoding-hash)) - stream - (let ((octet (gethash (char-code char) encoding-hash))) - (unless octet - (signal-encoding-error stream "~S is not in this encoding." char)) - (write-byte* octet sink)) - char)) - -(defmethod char-to-octets ((stream flexi-utf-8-output-stream) char sink) - (declare (optimize speed)) - (let ((char-code (char-code char))) - (tagbody - (cond ((< char-code #x80) - (write-byte* char-code sink) - (go zero)) - ((< char-code #x800) - (write-byte* (logior #b11000000 (ldb (byte 5 6) char-code)) sink) - (go one)) - ((< char-code #x10000) - (write-byte* (logior #b11100000 (ldb (byte 4 12) char-code)) sink) - (go two)) - ((< char-code #x200000) - (write-byte* (logior #b11110000 (ldb (byte 3 18) char-code)) sink) - (go three)) - ((< char-code #x4000000) - (write-byte* (logior #b11111000 (ldb (byte 2 24) char-code)) sink) - (go four)) - (t (write-byte* (logior #b11111100 (ldb (byte 1 30) char-code)) sink))) - (write-byte* (logior #b10000000 (ldb (byte 6 24) char-code)) sink) - four - (write-byte* (logior #b10000000 (ldb (byte 6 18) char-code)) sink) - three - (write-byte* (logior #b10000000 (ldb (byte 6 12) char-code)) sink) - two - (write-byte* (logior #b10000000 (ldb (byte 6 6) char-code)) sink) - one - (write-byte* (logior #b10000000 (ldb (byte 6 0) char-code)) sink) - zero)) - char) - -(defmethod char-to-octets ((stream flexi-utf-16-le-output-stream) char sink) - (declare (optimize speed)) - (flet ((write-word (word) - (write-byte* (ldb (byte 8 0) word) sink) - (write-byte* (ldb (byte 8 8) word) sink))) - (declare (inline write-word) (dynamic-extent (function write-word))) - (let ((char-code (char-code char))) - (cond ((< char-code #x10000) - (write-word char-code)) - (t (decf char-code #x10000) - (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) - char) - -(defmethod char-to-octets ((stream flexi-utf-16-be-output-stream) char sink) - (declare (optimize speed)) - (flet ((write-word (word) - (write-byte* (ldb (byte 8 8) word) sink) - (write-byte* (ldb (byte 8 0) word) sink))) - (declare (inline write-word) (dynamic-extent (function write-word))) - (let ((char-code (char-code char))) - (cond ((< char-code #x10000) - (write-word char-code)) - (t (decf char-code #x10000) - (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) - char) - -(defmethod char-to-octets ((stream flexi-utf-32-le-output-stream) char sink) - (declare (optimize speed)) - (loop with char-code = (char-code char) - for position in '(0 8 16 24) do - (write-byte* (ldb (byte 8 position) char-code) sink)) - char) - -(defmethod char-to-octets ((stream flexi-utf-32-be-output-stream) char sink) - (declare (optimize speed)) - (loop with char-code = (char-code char) - for position in '(24 16 8 0) do - (write-byte* (ldb (byte 8 position) char-code) sink)) - char) - -(defmethod char-to-octets ((stream flexi-cr-mixin) char sink) - "The `base' method for all streams which need end-of-line -conversion. Uses CALL-NEXT-METHOD to do the actual work of sending -one or more characters to SINK." - (declare (optimize speed)) (with-accessors ((external-format flexi-stream-external-format)) stream - (case char - (#\Newline - (case (external-format-eol-style external-format) - (:cr (call-next-method stream #\Return sink)) - (:crlf (call-next-method stream #\Return sink) - (call-next-method stream #\Linefeed sink)))) - (otherwise (call-next-method))) - char)) + (char-to-octets external-format + char + (lambda (octet) + (write-byte* octet stream)) + stream))) (defmethod stream-write-char :after ((stream flexi-output-stream) char) (declare (optimize speed)) @@ -297,8 +175,13 @@ :start start :end end :from-end t))) - (loop for index from start below end - do (char-to-octets stream (aref sequence index) buffer) + (loop with format = (flexi-stream-external-format stream) + for index from start below end + do (char-to-octets format + (aref sequence index) + (lambda (octet) + (vector-push octet buffer)) + stream) when (>= (fill-pointer buffer) +buffer-size+) do (write-sequence buffer (flexi-stream-stream stream)) (setf (fill-pointer buffer) 0) Modified: branches/edi/packages.lisp ============================================================================== --- branches/edi/packages.lisp (original) +++ branches/edi/packages.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.30 2007/10/11 20:23:53 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.31 2008/05/17 13:50:16 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: branches/edi/specials.lisp ============================================================================== --- branches/edi/specials.lisp (original) +++ branches/edi/specials.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.25 2007/12/29 21:17:06 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.26 2008/05/17 13:50:16 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: branches/edi/stream.lisp ============================================================================== --- branches/edi/stream.lisp (original) +++ branches/edi/stream.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.53 2007/12/29 22:26:04 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.57 2008/05/17 14:21:20 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -49,45 +49,6 @@ allow for multi-octet external formats. FLEXI-STREAM itself is a mixin and should not be instantiated.")) -(define-condition flexi-stream-error (stream-error) - () - (:documentation "Superclass for all errors related to -flexi streams.")) - -(define-condition flexi-stream-simple-error (flexi-stream-error simple-condition) - () - (:documentation "Like FLEXI-STREAM-ERROR but with formatting -capabilities.")) - -(define-condition flexi-stream-element-type-error (flexi-stream-error) - ((element-type :initarg :element-type - :reader flexi-stream-element-type-error-element-type)) - (:report (lambda (condition stream) - (format stream "Element type ~S not allowed." - (flexi-stream-element-type-error-element-type condition)))) - (:documentation "Errors of this type are signalled if the flexi -stream has a wrong element type.")) - -(define-condition flexi-stream-encoding-error (flexi-stream-simple-error) - () - (:documentation "Errors of this type are signalled if there is an -encoding problem.")) - -(define-condition flexi-stream-position-spec-error (flexi-stream-simple-error) - ((position-spec :initarg :position-spec - :reader flexi-stream-position-spec-error-position-spec)) - (:documentation "Errors of this type are signalled if an -erroneous position spec is used in conjunction with -FILE-POSITION.")) - -(defun signal-encoding-error (flexi-stream format-control &rest format-args) - "Convenience function similar to ERROR to signal conditions of type -FLEXI-STREAM-ENCODING-ERROR." - (error 'flexi-stream-encoding-error - :format-control format-control - :format-arguments format-args - :stream flexi-stream)) - (defun maybe-convert-external-format (external-format) "Given an external format designator \(a keyword, a list, or an EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT @@ -110,9 +71,7 @@ (error 'flexi-stream-element-type-error :element-type element-type :stream flexi-stream)) - (setq external-format (maybe-convert-external-format external-format))) - ;; set actual class and maybe contents of 8-bit encoding slots - (set-class flexi-stream)) + (setq external-format (maybe-convert-external-format external-format)))) (defmethod (setf flexi-stream-external-format) :around (new-value (flexi-stream flexi-stream)) "Converts the new value to an EXTERNAL-FORMAT object if @@ -226,461 +185,6 @@ MAKE-INSTANCE to create a new FLEXI-IO-STREAM but use MAKE-FLEXI-STREAM instead.")) -(defclass flexi-cr-mixin () - () - (:documentation "A mixin for flexi streams which need -end-of-line conversion, i.e. for those where the end-of-line -designator is /not/ the single character #\Linefeed.")) - -(defclass flexi-8-bit-stream (flexi-stream) - ((encoding-hash :accessor flexi-stream-encoding-hash)) - (:documentation "The class for all flexi streams which use an 8-bit -encoding and thus need an additional slot for the encoding hash.")) - -(defclass flexi-8-bit-input-stream (flexi-input-stream flexi-8-bit-stream) - ((encoding-table :accessor flexi-stream-encoding-table)) - (:documentation "The class for all flexi input streams which use an -8-bit encoding and thus need an additional slot for the encoding -table.")) - -(defclass flexi-cr-8-bit-input-stream (flexi-cr-mixin flexi-8-bit-input-stream) - () - (:documentation "The class for all flexi input streams which -use an 8-bit encoding /and/ need end-of-line conversion.")) - -(defclass flexi-ascii-input-stream (flexi-8-bit-input-stream) - () - (:documentation "Special class for flexi input streams which -use the US-ASCCI encoding.")) - -(defclass flexi-cr-ascii-input-stream (flexi-cr-mixin flexi-ascii-input-stream) - () - (:documentation "Special class for flexi input streams which -use the US-ASCCI encoding /and/ need end-of-line conversion.")) - -(defclass flexi-latin-1-input-stream (flexi-8-bit-input-stream) - () - (:documentation "Special class for flexi input streams which -use the ISO-8859-1 encoding.")) - -(defclass flexi-cr-latin-1-input-stream (flexi-cr-mixin flexi-latin-1-input-stream) - () - (:documentation "Special class for flexi input streams which -use the ISO-8859-1 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-utf-32-le-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-32-le-input-stream (flexi-cr-mixin flexi-utf-32-le-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-32-be-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-32-be-input-stream (flexi-cr-mixin flexi-utf-32-be-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-le-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-16-le-input-stream (flexi-cr-mixin flexi-utf-16-le-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-16-be-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-16-be-input-stream (flexi-cr-mixin flexi-utf-16-be-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-8-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-8 encoding.")) - -(defclass flexi-cr-utf-8-input-stream (flexi-cr-mixin flexi-utf-8-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-8 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-8-bit-output-stream (flexi-output-stream flexi-8-bit-stream) - () - (:documentation "The class for all flexi output streams which use an -8-bit encoding.")) - -(defclass flexi-cr-8-bit-output-stream (flexi-cr-mixin flexi-8-bit-output-stream) - () - (:documentation "The class for all flexi output streams which -use an 8-bit encoding /and/ need end-of-line conversion.")) - -(defclass flexi-ascii-output-stream (flexi-8-bit-output-stream) - () - (:documentation "Special class for flexi output streams which -use the US-ASCCI encoding.")) - -(defclass flexi-cr-ascii-output-stream (flexi-cr-mixin flexi-ascii-output-stream) - () - (:documentation "Special class for flexi output streams which -use the US-ASCCI encoding /and/ need end-of-line conversion.")) - -(defclass flexi-latin-1-output-stream (flexi-8-bit-output-stream) - () - (:documentation "Special class for flexi output streams which -use the ISO-8859-1 encoding.")) - -(defclass flexi-cr-latin-1-output-stream (flexi-cr-mixin flexi-latin-1-output-stream) - () - (:documentation "Special class for flexi output streams which -use the ISO-8859-1 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-utf-32-le-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-32-le-output-stream (flexi-cr-mixin flexi-utf-32-le-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-32-be-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-32-be-output-stream (flexi-cr-mixin flexi-utf-32-be-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-le-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-16-le-output-stream (flexi-cr-mixin flexi-utf-16-le-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-16-be-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-16-be-output-stream (flexi-cr-mixin flexi-utf-16-be-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-8-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-8 encoding.")) - -(defclass flexi-cr-utf-8-output-stream (flexi-cr-mixin flexi-utf-8-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-8 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-8-bit-io-stream (flexi-8-bit-input-stream flexi-8-bit-output-stream flexi-io-stream) - () - (:documentation "The class for all flexi I/O streams which use an -8-bit encoding.")) - -(defclass flexi-cr-8-bit-io-stream (flexi-cr-mixin flexi-8-bit-io-stream) - () - (:documentation "The class for all flexi I/O streams which use -an 8-bit encoding /and/ need end-of-line conversion.")) - -(defclass flexi-ascii-io-stream (flexi-ascii-input-stream flexi-ascii-output-stream flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the US-ASCCI encoding.")) - -(defclass flexi-cr-ascii-io-stream (flexi-cr-mixin flexi-ascii-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the US-ASCCI encoding /and/ need end-of-line conversion.")) - -(defclass flexi-latin-1-io-stream (flexi-latin-1-input-stream flexi-latin-1-output-stream flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the ISO-8859-1 encoding.")) - -(defclass flexi-cr-latin-1-io-stream (flexi-cr-mixin flexi-latin-1-io-stream) - () - (:documentation "Special class for flexi input streams which -use the ISO-8859-1 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-utf-32-le-io-stream (flexi-utf-32-le-input-stream - flexi-utf-32-le-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-32-le-io-stream (flexi-cr-mixin flexi-utf-32-le-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with little-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-32-be-io-stream (flexi-utf-32-be-input-stream - flexi-utf-32-be-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-32-be-io-stream (flexi-cr-mixin flexi-utf-32-be-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-le-io-stream (flexi-utf-16-le-input-stream - flexi-utf-16-le-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-16-le-io-stream (flexi-cr-mixin flexi-utf-16-le-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with little-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-be-io-stream (flexi-utf-16-be-input-stream - flexi-utf-16-be-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-16-be-io-stream (flexi-cr-mixin flexi-utf-16-be-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-8-io-stream (flexi-utf-8-input-stream flexi-utf-8-output-stream flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-8 encoding.")) - -(defclass flexi-cr-utf-8-io-stream (flexi-cr-mixin flexi-utf-8-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-8 encoding /and/ need end-of-line conversion.")) - -(defmethod (setf flexi-stream-external-format) :after (new-value (stream flexi-stream)) - "After we've changed the external format of a flexi stream, we -might have to change its actual class and maybe also the contents -of its 8-bit encoding slots." - (declare (ignore new-value) - (optimize speed)) - ;; note that it's potentially dangerous to call SET-CLASS from - ;; within a method, see for example this thread: - ;; <http://thread.gmane.org/gmane.lisp.lispworks.general/6269> - (set-class stream)) - -(defmethod set-class ((stream flexi-input-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-cr-ascii-input-stream - 'flexi-ascii-input-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-cr-latin-1-input-stream - 'flexi-latin-1-input-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-cr-8-bit-input-stream - 'flexi-8-bit-input-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-cr-utf-8-input-stream - 'flexi-utf-8-input-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-16-le-input-stream - 'flexi-cr-utf-16-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-16-le-input-stream - 'flexi-utf-16-be-input-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-32-le-input-stream - 'flexi-cr-utf-32-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-32-le-input-stream - 'flexi-utf-32-be-input-stream)))))))))) - -(defmethod set-class ((stream flexi-output-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-cr-ascii-output-stream - 'flexi-ascii-output-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-cr-latin-1-output-stream - 'flexi-latin-1-output-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-cr-8-bit-output-stream - 'flexi-8-bit-output-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-cr-utf-8-output-stream - 'flexi-utf-8-output-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-16-le-output-stream - 'flexi-cr-utf-16-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-16-le-output-stream - 'flexi-utf-16-be-output-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-32-le-output-stream - 'flexi-cr-utf-32-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-32-le-output-stream - 'flexi-utf-32-be-output-stream)))))))))) - -(defmethod set-class ((stream flexi-io-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-cr-ascii-io-stream - 'flexi-ascii-io-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-cr-latin-1-io-stream - 'flexi-latin-1-io-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-cr-8-bit-io-stream - 'flexi-8-bit-io-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-cr-utf-8-io-stream - 'flexi-utf-8-io-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-16-le-io-stream - 'flexi-cr-utf-16-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-16-le-io-stream - 'flexi-utf-16-be-io-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-32-le-io-stream - 'flexi-cr-utf-32-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-32-le-io-stream - 'flexi-utf-32-be-io-stream)))))))))) - -(defmethod set-class :after ((stream flexi-stream)) - "After we've changed the actual class of a flexi stream we may -have to set the contents of the 8-bit enconding slots as well." - (declare (optimize speed)) - (set-encoding-hash stream) - (set-encoding-table stream)) - -(defgeneric set-encoding-hash (stream) - (:method (stream)) - (:documentation "Sets the value of the ENCODING-HASH slot of -STREAM if necessary. The default method does nothing.")) - -(defgeneric set-encoding-table (stream) - (:method (stream)) - (:documentation "Sets the value of the ENCODING-TABLE slot of -STREAM if necessary. The default method does nothing.")) - -(defmethod set-encoding-hash ((stream flexi-8-bit-stream)) - "Sets the value of the ENCODING-HASH slot of STREAM depending -on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format) - (encoding-hash flexi-stream-encoding-hash)) - stream - (let ((external-format-name (external-format-name external-format))) - (setq encoding-hash - (cond ((ascii-name-p external-format-name) +ascii-hash+) - ((koi8-r-name-p external-format-name) +koi8-r-hash+) - ((iso-8859-name-p external-format-name) - (cdr (assoc external-format-name +iso-8859-hashes+ :test #'eq))) - ((code-page-name-p external-format-name) - (cdr (assoc (external-format-id external-format) +code-page-hashes+)))))))) - -(defmethod set-encoding-table ((stream flexi-8-bit-input-stream)) - "Sets the value of the ENCODING-TABLE slot of STREAM depending -on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format) - (encoding-table flexi-stream-encoding-table)) - stream - (let ((external-format-name (external-format-name external-format))) - (setq encoding-table - (cond ((ascii-name-p external-format-name) +ascii-table+) - ((koi8-r-name-p external-format-name) +koi8-r-table+) - ((iso-8859-name-p external-format-name) - (cdr (assoc external-format-name +iso-8859-tables+ :test #'eq))) - ((code-page-name-p external-format-name) - (cdr (assoc (external-format-id external-format) +code-page-tables+)))))))) - #+:cmu (defmethod input-stream-p ((stream flexi-io-stream)) "Explicitly states whether this is an input stream." Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.4 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.5 2008/05/17 13:50:16 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: branches/edi/test/packages.lisp ============================================================================== --- branches/edi/test/packages.lisp (original) +++ branches/edi/test/packages.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/packages.lisp,v 1.4 2007/01/01 23:47:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/packages.lisp,v 1.6 2008/05/17 16:38:26 edi Exp $ -;;; Copyright (c) 2006-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -30,4 +30,5 @@ (in-package :cl-user) (defpackage :flexi-streams-test - (:use :cl :flexi-streams)) + (:use :cl :flexi-streams) + (:export :run-tests)) Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.17 2007/12/29 22:58:44 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.20 2008/05/17 13:50:18 edi Exp $ -;;; Copyright (c) 2006-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -89,13 +89,17 @@ (append args `(:eol-style ,eol-style :little-endian ,little-endian)))))))) -(defun create-test-combinations (file-name symbols) - "For a name suffix FILE-NAME and a list of symbols SYMBOLS -denoting different encodings of the corresponding file returns a -list of lists which can be used as arglists for COMPARE-FILES." +(defun create-test-combinations (file-name symbols &optional simplep) + "For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting +different encodings of the corresponding file returns a list of lists +which can be used as arglists for COMPARE-FILES. If SIMPLEP is true, +a list which can be used for the string tests below is returned." (let ((file-variants (loop for symbol in symbols nconc (create-file-variants file-name symbol)))) (loop for (name-in . external-format-in) in file-variants + when simplep + collect (list name-in external-format-in) + else nconc (loop for (name-out . external-format-out) in file-variants collect (list name-in external-format-in name-out external-format-out))))) @@ -200,6 +204,27 @@ #+:lispworks (terpri *error-output*))))) +(defun file-as-octet-vector (pathspec) + "Returns the contents of the file denoted by PATHSPEC as a vector of +octets." + (with-open-file (in pathspec :element-type 'octet) + (let ((vector (make-array (file-length in) :element-type 'octet))) + (read-sequence vector in) + vector))) + +(defun file-as-string (pathspec external-format) + "Reads the contents of the file denoted by PATHSPEC using the +external format EXTERNAL-FORMAT and returns the result as a string." + (with-open-file (in pathspec :element-type 'octet) + (let* ((number-of-octets (file-length in)) + (in (make-flexi-stream in :external-format external-format)) + (string (make-array number-of-octets + :element-type #+:lispworks 'lw:simple-char + #-:lispworks 'character + :fill-pointer t))) + (setf (fill-pointer string) (read-sequence string in)) + string))) + (defmacro with-test ((test-description) &body body) "Defines a test. Two utilities are available inside of the body of the maco: The function FAIL, and the macro CHECK. FAIL, the lowest @@ -231,6 +256,21 @@ (terpri *error-output*)) ,successp)))) +(defun string-test (pathspec external-format) + "Tests whether conversion from strings to octets and vice versa +using the external format EXTERNAL-FORMAT works as expected, using the +contents of the file denoted by PATHSPEC as test data and assuming +that the stream conversion functions work." + (let* ((full-path (merge-pathnames pathspec *this-file*)) + (octets-vector (file-as-octet-vector full-path)) + (octets-list (coerce octets-vector 'list)) + (string (file-as-string full-path external-format))) + (with-test ((format nil "String tests with format ~S." + (flex::normalize-external-format external-format))) + (check (string= (octets-to-string octets-vector :external-format external-format) string)) + (check (string= (octets-to-string octets-list :external-format external-format) string)) + (check (equalp (string-to-octets string :external-format external-format) octets-vector))))) + (defmacro using-values ((&rest values) &body body) "Executes BODY and feeds an element from VALUES to the USE-VALUE restart each time a FLEXI-STREAM-ENCODING-ERROR is signalled. Signals @@ -262,6 +302,9 @@ (defun encoding-error-handling-test () "Tests several possible encoding errors and how they are handled." (with-test ("Handling of encoding errors.") + ;; handling of EOF in the middle of CRLF + (check (string= #.(string #\Return) + (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf)))) (let ((*substitution-char* #\?)) ;; :ASCII doesn't have characters with char codes > 127 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii))) @@ -326,13 +369,18 @@ CREATE-TEST-COMBINATIONS, runs test for handling of encoding errors, and shows simple statistics at the end." (let* ((*test-success-counter* 0) - (args-list (loop for (file-name symbols) in *test-files* - nconc (create-test-combinations file-name symbols))) - (no-tests (* 4 (length args-list)))) + (compare-files-args-list (loop for (file-name symbols) in *test-files* + nconc (create-test-combinations file-name symbols))) + (no-tests (* 4 (length compare-files-args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) - (dolist (args args-list) - (apply #'compare-files args)) + (dolist (args compare-files-args-list) + (apply 'compare-files args)) + (let ((string-test-args-list (loop for (file-name symbols) in *test-files* + nconc (create-test-combinations file-name symbols t)))) + (incf no-tests (length string-test-args-list)) + (dolist (args string-test-args-list) + (apply 'string-test args))) (incf no-tests) (encoding-error-handling-test) (incf no-tests) Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Sat May 17 18:31:08 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.13 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.14 2008/05/17 13:50:16 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions

1 0

[flexi-streams-cvs] r22 - branches/edi
by eweitz＠common-lisp.net 17 May '08

17 May '08

Author: eweitz Date: Sat May 17 18:28:41 2008 New Revision: 22 Added: branches/edi/ - copied from r21, trunk/ Log: Copy trunk to branch so we can see the diffs

1 0