Author: eweitz
Date: Fri May 23 11:00:03 2008
New Revision: 50
Added:
trunk/lw-char-stream.lisp
Removed:
trunk/lw-binary-stream.lisp
Modified:
trunk/CHANGELOG
trunk/doc/index.html
trunk/flexi-streams.asd
trunk/input.lisp
trunk/output.lisp
Log:
Update to 0.15.3
Modified: trunk/CHANGELOG
==============================================================================
--- trunk/CHANGELOG (original)
+++ trunk/CHANGELOG Fri May 23 11:00:03 2008
@@ -1,3 +1,16 @@
+Version 0.15.3
+2008-05-23
+Avoid CHANGE-CLASS on LispWorks if possible
+
+Version 0.15.2
+2008-05-22
+Remove debugging remnants (d'ooh!)
+
+Version 0.15.1
+2008-05-21
+Direct access to underlying stream in case of binary sequence operations
+More tests
+
Version 0.15.0
2008-05-21
Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans H�bner)
Modified: trunk/doc/index.html
==============================================================================
--- trunk/doc/index.html (original)
+++ trunk/doc/index.html Fri May 23 11:00:03 2008
@@ -224,7 +224,7 @@
<p>
FLEXI-STREAMS together with this documentation can be downloaded from <a
href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. The
-current version is 0.15.0.
+current version is 0.15.3.
<p>
Before you install FLEXI-STREAMS you first need to
install the <a
@@ -1060,7 +1060,7 @@
his work on making FLEXI-STREAMS faster.
<p>
-$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.108 2008/05/21 11:53:08 edi Exp $
+$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.111 2008/05/23 14:56:47 edi Exp $
<p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
</body>
Modified: trunk/flexi-streams.asd
==============================================================================
--- trunk/flexi-streams.asd (original)
+++ trunk/flexi-streams.asd Fri May 23 11:00:03 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.65 2008/05/21 11:53:07 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.69 2008/05/23 14:56:46 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -35,7 +35,7 @@
(in-package :flexi-streams-system)
(defsystem :flexi-streams
- :version "0.15.0"
+ :version "0.15.3"
:serial t
:components ((:file "packages")
(:file "mapping")
@@ -51,7 +51,7 @@
(:file "decode")
(:file "in-memory")
(:file "stream")
- #+:lispworks (:file "lw-binary-stream")
+ #+:lispworks (:file "lw-char-stream")
(:file "output")
(:file "input")
(:file "io")
Modified: trunk/input.lisp
==============================================================================
--- trunk/input.lisp (original)
+++ trunk/input.lisp Fri May 23 11:00:03 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.70 2008/05/21 00:18:35 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.75 2008/05/23 14:43:09 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -55,9 +55,8 @@
#+:lispworks
(defmethod read-byte* ((flexi-input-stream flexi-input-stream))
- "Reads one byte \(octet) from the underlying stream of
-FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not
-empty)."
+ "Reads one byte \(octet) from the underlying \(binary) stream of
+FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)."
(declare #.*standard-optimize-settings*)
(with-accessors ((position flexi-stream-position)
(bound flexi-stream-bound)
@@ -71,20 +70,14 @@
(return-from read-byte* nil))
(incf position)
(or (pop octet-stack)
- ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all
- ;; bivalent streams in LispWorks
- (let* ((buffer (make-array 1 :element-type 'octet))
- (new-position (read-sequence buffer stream)))
- (cond ((zerop new-position)
- (decf position) nil)
- (t (aref buffer 0)))))))
+ (read-byte stream nil nil)
+ (progn (decf position) nil))))
#+:lispworks
-(defmethod read-byte* ((flexi-input-stream flexi-binary-input-stream))
+(defmethod read-byte* ((flexi-input-stream flexi-char-input-stream))
"Reads one byte \(octet) from the underlying stream of
FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty).
-Optimized version \(only needed for LispWorks) in case the underlying
-stream is binary."
+Only used for LispWorks bivalent streams which aren't binary."
(declare #.*standard-optimize-settings*)
(with-accessors ((position flexi-stream-position)
(bound flexi-stream-bound)
@@ -98,8 +91,13 @@
(return-from read-byte* nil))
(incf position)
(or (pop octet-stack)
- (read-byte stream nil nil)
- (progn (decf position) nil))))
+ ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all
+ ;; bivalent streams in LispWorks
+ (let* ((buffer (make-array 1 :element-type 'octet))
+ (new-position (read-sequence buffer stream)))
+ (cond ((zerop new-position)
+ (decf position) nil)
+ (t (aref buffer 0)))))))
(defmethod stream-clear-input ((flexi-input-stream flexi-input-stream))
"Calls the corresponding method for the underlying input stream
@@ -201,7 +199,7 @@
based on the element type of the sequence \(which takes precedence)
and the element type of the stream. What you'll really get might also
depend on your Lisp. Some of the implementations are more picky than
-others - see for example FLEXI-STREAMS-TEST:READ-SEQUENCE-TEST."
+others - see for example FLEXI-STREAMS-TEST::SEQUENCE-TEST."
(declare #.*standard-optimize-settings*)
(declare (fixnum start end))
(with-accessors ((position flexi-stream-position)
@@ -213,21 +211,37 @@
(element-type flexi-stream-element-type)
(stream flexi-stream-stream))
flexi-input-stream
+ (when (>= start end)
+ (return-from stream-read-sequence start))
+ (when (or (subtypep (etypecase sequence
+ (vector (array-element-type sequence))
+ (list t))
+ 'integer)
+ (and (not (stringp sequence))
+ (type-equal element-type 'octet)))
+ ;; if binary data is requested, just read from the underlying
+ ;; stream directly and skip the rest (but flush octet stack
+ ;; first)
+ (let ((index start))
+ (declare (fixnum index))
+ (when octet-stack
+ (replace sequence octet-stack :start1 start :end1 end)
+ (let ((octets-flushed (min (length octet-stack) (- end start))))
+ (incf index octets-flushed)
+ (setq octet-stack (nthcdr octets-flushed octet-stack))))
+ (setq index (read-sequence sequence stream :start index :end end))
+ (when (> index start)
+ (setq last-char-code nil
+ last-octet (elt sequence (1- index))))
+ (return-from stream-read-sequence index)))
(let* (buffer
(buffer-pos 0)
(buffer-end 0)
(index start)
- ;; whether we will deliver characters and thus the number
- ;; of octets to read might not be equal to the number of
- ;; sequence elements to fill
- (want-chars-p (or (stringp sequence)
- (and (vectorp sequence)
- (not (subtypep (array-element-type sequence) 'integer)))
- (not (type-equal element-type 'octet))))
;; whether we will later be able to rewind the stream if
;; needed (to get rid of unused octets in the buffer)
- (can-rewind-p (and want-chars-p (maybe-rewind stream 0)))
- (factor (if want-chars-p (encoding-factor external-format) 1))
+ (can-rewind-p (maybe-rewind stream 0))
+ (factor (encoding-factor external-format))
(integer-factor (floor factor))
;; it's an interesting question whether it makes sense
;; performance-wise to make RESERVE significantly bigger
@@ -237,7 +251,7 @@
((not can-rewind-p) (* 2 integer-factor))
(t (ceiling (* (- factor integer-factor) (- end start)))))))
(declare (fixnum buffer-pos buffer-end index integer-factor reserve)
- (boolean want-chars-p can-rewind-p))
+ (boolean can-rewind-p))
(flet ((compute-fill-amount ()
"Computes the amount of octets we can savely read into
the buffer without violating the stream's bound \(if there is one) and
@@ -293,23 +307,17 @@
(unread-char% char flexi-input-stream)))
(declare (dynamic-extent (function next-octet) (function unreader)))
(let ((*current-unreader* #'unreader))
- (macrolet ((iterate (octetp set-place)
+ (macrolet ((iterate (set-place)
"A very unhygienic macro to implement the
actual iteration through the sequence including housekeeping for the
-flexi stream. If OCTETP is true, we put octets into the stream,
-otherwise characters. SET-PLACE is the place \(using the index INDEX)
-used to access the sequence."
+flexi stream. SET-PLACE is the place \(using the index INDEX) used to
+access the sequence."
`(flet ((leave ()
"This is the function used to abort
the LOOP iteration below."
(when (> index start)
- ;; if something was read at all,
- ;; update LAST-OCTET and
- ;; LAST-CHAR-CODE accordingly
- (setq ,(if octetp 'last-char-code 'last-octet)
- nil
- ,(if octetp 'last-octet 'last-char-code)
- ,(sublis '((index . (1- index))) set-place)))
+ (setq last-octet nil
+ last-char-code ,(sublis '((index . (1- index))) set-place)))
(return-from stream-read-sequence index)))
(loop
(when (>= index end)
@@ -327,28 +335,15 @@
(push (aref (the (array octet *) buffer) buffer-end)
octet-stack)))))
(leave))
- (let ((next-thing ,(if octetp
- '(next-octet)
- '(octets-to-char-code external-format #'next-octet))))
- (unless next-thing (leave))
- (setf ,set-place ,(if octetp 'next-thing '(code-char next-thing)))
+ (let ((next-char-code (octets-to-char-code external-format #'next-octet)))
+ (unless next-char-code
+ (leave))
+ (setf ,set-place (code-char next-char-code))
(incf index))))))
(etypecase sequence
- (string (iterate nil (char sequence index)))
- (array
- (let ((array-element-type (array-element-type sequence)))
- (cond ((type-equal array-element-type 'octet)
- (iterate t (aref (the (array octet *) sequence) index)))
- ((or (subtypep array-element-type 'integer)
- (type-equal element-type 'octet))
- (iterate t (aref sequence index)))
- (t
- (iterate nil (aref sequence index))))))
- (list
- (cond ((type-equal element-type 'octet)
- (iterate t (nth index sequence)))
- (t
- (iterate nil (nth index sequence)))))))))))))
+ (string (iterate (char sequence index)))
+ (array (iterate (aref sequence index)))
+ (list (iterate (nth index sequence)))))))))))
(defmethod stream-unread-char ((stream flexi-input-stream) char)
"Implements UNREAD-CHAR for streams of type FLEXI-INPUT-STREAM.
Added: trunk/lw-char-stream.lisp
==============================================================================
--- (empty file)
+++ trunk/lw-char-stream.lisp Fri May 23 11:00:03 2008
@@ -0,0 +1,77 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/flexi-streams/lw-char-stream.lisp,v 1.1 2008/05/23 14:43:09 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)
+
+(defclass flexi-char-output-stream (flexi-output-stream)
+ ()
+ (:documentation "This class is for output streams where the
+underlying stream is bivalent but not binary. It exists solely for
+the purpose of optimizing output to binary streams on LispWorks. See
+WRITE-BYTE*."))
+
+(defclass flexi-char-input-stream (flexi-input-stream)
+ ()
+ (:documentation "This class is for input streams where the
+underlying stream is bivalent but not binary. It exists solely for
+the purpose of optimizing input to binary streams on LispWorks. See
+READ-BYTE*."))
+
+(defclass flexi-char-io-stream (flexi-char-input-stream flexi-char-output-stream flexi-io-stream)
+ ()
+ (:documentation "This class is for bidirectional streams where the
+underlying stream is bivalent but not binary. It exists solely for
+the purpose of optimizing input and output from/to binary streams on
+LispWorks. See READ-BYTE* and WRITE-BYTE*."))
+
+(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 #.*standard-optimize-settings*)
+ (declare (ignore initargs))
+ (with-accessors ((stream flexi-stream-stream))
+ flexi-stream
+ (unless (subtypep (stream-element-type stream) 'octet)
+ (change-class flexi-stream
+ (typecase flexi-stream
+ (flexi-io-stream 'flexi-char-io-stream)
+ (otherwise 'flexi-char-output-stream))))))
+
+(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 #.*standard-optimize-settings*)
+ (declare (ignore initargs))
+ (with-accessors ((stream flexi-stream-stream))
+ flexi-stream
+ (unless (subtypep (stream-element-type stream) 'octet)
+ (change-class flexi-stream
+ (typecase flexi-stream
+ (flexi-io-stream 'flexi-char-io-stream)
+ (otherwise 'flexi-char-input-stream))))))
Modified: trunk/output.lisp
==============================================================================
--- trunk/output.lisp (original)
+++ trunk/output.lisp Fri May 23 11:00:03 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.60 2008/05/21 01:26:43 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.63 2008/05/23 14:43:09 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -44,6 +44,15 @@
#+:lispworks
(defmethod write-byte* (byte (flexi-output-stream flexi-output-stream))
(declare #.*standard-optimize-settings*)
+ (with-accessors ((stream flexi-stream-stream))
+ flexi-output-stream
+ (write-byte byte stream)))
+
+#+:lispworks
+(defmethod write-byte* (byte (flexi-output-stream flexi-char-output-stream))
+ "This method is only used for LispWorks bivalent streams which
+aren't binary."
+ (declare #.*standard-optimize-settings*)
;; we use WRITE-SEQUENCE because WRITE-BYTE doesn't work with all
;; bivalent streams in LispWorks (4.4.6)
(with-accessors ((stream flexi-stream-stream))
@@ -53,15 +62,6 @@
stream)
byte))
-#+:lispworks
-(defmethod write-byte* (byte (flexi-output-stream flexi-binary-output-stream))
- "Optimized version \(only needed for LispWorks) in case the
-underlying stream is binary."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- flexi-output-stream
- (write-byte byte stream)))
-
(defmethod stream-write-char ((stream flexi-output-stream) char)
(declare #.*standard-optimize-settings*)
(with-accessors ((external-format flexi-stream-external-format))
@@ -142,15 +142,18 @@
(external-format flexi-stream-external-format)
(stream flexi-stream-stream))
stream
+ (when (>= start end)
+ (return-from stream-write-sequence sequence))
+ (when (and (vectorp sequence)
+ (subtypep (array-element-type sequence) 'integer))
+ ;; if this is pure binary output, just send all the stuff to the
+ ;; underlying stream directly and skip the rest
+ (setq column nil)
+ (return-from stream-write-sequence
+ (write-sequence sequence stream :start start :end end)))
(let* ((octet-seen-p nil)
(buffer-pos 0)
- ;; whether we might receive characters and thus the number
- ;; of octets to output might not be equal to the number of
- ;; sequence elements to write
- (chars-p (or (listp sequence)
- (and (vectorp sequence)
- (not (subtypep (array-element-type sequence) 'integer)))))
- (factor (if chars-p (encoding-factor external-format) 1))
+ (factor (encoding-factor external-format))
(buffer-size (min +buffer-size+ (ceiling (* factor (- end start)))))
(buffer (make-octet-buffer buffer-size)))
(declare (fixnum buffer-pos buffer-size)
@@ -178,28 +181,20 @@
(write-octet object))
(character (write-character object)))))
(declare (dynamic-extent (function write-octet)))
- (macrolet ((iterate (octets-p output-form)
+ (macrolet ((iterate (output-form)
"An unhygienic macro to implement the actual
iteration through SEQUENCE. OUTPUT-FORM is the form to retrieve one
-sequence element and put its octet representation into the buffer.
-OCTETS-P is true if we know in advance that we will send octets."
- `(progn
- ,@(if octets-p '((setq octet-seen-p t)))
- (loop for index of-type fixnum from start below end
- do ,output-form
- finally (when (plusp buffer-pos)
- (flush-buffer))))))
+sequence element and put its octet representation into the buffer."
+ `(loop for index of-type fixnum from start below end
+ do ,output-form
+ finally (when (plusp buffer-pos)
+ (flush-buffer)))))
(etypecase sequence
- (string (iterate nil (write-character (char sequence index))))
- (array
- (let ((array-element-type (array-element-type sequence)))
- (cond ((type-equal array-element-type 'octet)
- (iterate t (write-octet (aref (the (array octet *) sequence) index))))
- ((subtypep array-element-type 'integer)
- (iterate t (write-octet (aref sequence index))))
- (t (iterate nil (write-object (aref sequence index)))))))
- (list (iterate nil (write-object (nth index sequence)))))
- ;; update the column slot, setting if to NIL if we sent octets
+ (string (iterate (write-character (char sequence index))))
+ (array (iterate (write-object (aref sequence index))))
+ (list (iterate (write-object (nth index sequence)))))
+ ;; update the column slot, setting it to NIL if we sent
+ ;; octets
(setq column
(cond (octet-seen-p nil)
(t (let ((last-newline-pos (position #\Newline sequence
@@ -208,8 +203,7 @@
:end end
:from-end t)))
(cond (last-newline-pos (- end last-newline-pos 1))
- (column (+ column (- end start))))))))))))
-
+ (column (+ column (- end start))))))))))))
sequence)
(defmethod stream-write-string ((stream flexi-output-stream) string
Author: eweitz
Date: Wed May 21 07:55:21 2008
New Revision: 44
Modified:
branches/edi/CHANGELOG
branches/edi/doc/index.html
branches/edi/flexi-streams.asd
Log:
Make it 0.15.0
Modified: branches/edi/CHANGELOG
==============================================================================
--- branches/edi/CHANGELOG (original)
+++ branches/edi/CHANGELOG Wed May 21 07:55:21 2008
@@ -1,3 +1,5 @@
+Version 0.15.0
+2008-05-21
Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans H�bner)
Version 0.14.0
Modified: branches/edi/doc/index.html
==============================================================================
--- branches/edi/doc/index.html (original)
+++ branches/edi/doc/index.html Wed May 21 07:55:21 2008
@@ -224,7 +224,7 @@
<p>
FLEXI-STREAMS together with this documentation can be downloaded from <a
href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. The
-current version is 0.14.0.
+current version is 0.15.0.
<p>
Before you install FLEXI-STREAMS you first need to
install the <a
@@ -1060,7 +1060,7 @@
his work on making FLEXI-STREAMS faster.
<p>
-$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.107 2008/05/21 01:43:45 edi Exp $
+$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.108 2008/05/21 11:53:08 edi Exp $
<p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
</body>
Modified: branches/edi/flexi-streams.asd
==============================================================================
--- branches/edi/flexi-streams.asd (original)
+++ branches/edi/flexi-streams.asd Wed May 21 07:55:21 2008
@@ -1,7 +1,7 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.64 2008/05/20 23:01:51 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.65 2008/05/21 11:53:07 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
@@ -35,7 +35,7 @@
(in-package :flexi-streams-system)
(defsystem :flexi-streams
- :version "0.14.0"
+ :version "0.15.0"
:serial t
:components ((:file "packages")
(:file "mapping")
Author: eweitz
Date: Tue May 20 21:49:41 2008
New Revision: 43
Modified:
branches/edi/doc/index.html
branches/edi/packages.lisp
branches/edi/strings.lisp
Log:
New function octet-length
Modified: branches/edi/doc/index.html
==============================================================================
--- branches/edi/doc/index.html (original)
+++ branches/edi/doc/index.html Tue May 20 21:49:41 2008
@@ -115,6 +115,7 @@
<ol>
<li><a href="#string-to-octets"><code>string-to-octets</code></a>
<li><a href="#octets-to-string"><code>octets-to-string</code></a>
+ <li><a href="#octet-length"><code>octet-length</code></a>
</ol>
</ol>
<li><a href="#position">File positions</a>
@@ -470,8 +471,8 @@
CL-USER 5 > (make-external-format :ucs-2be)
#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CRLF :LITTLE-ENDIAN NIL) 2067DBE4>
-CL-USER 6 > (make-external-format :ucs-2be :eol-style :br)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :BR :LITTLE-ENDIAN NIL) 206B54AC>
+CL-USER 6 > (make-external-format :ucs-2be :eol-style :cr)
+#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CR :LITTLE-ENDIAN NIL) 206B54AC>
</pre>
</blockquote>
@@ -982,7 +983,8 @@
<blockquote><br>
Converts the Lisp string <code><i>string</i></code> from <code><i>start</i></code> to <code><i>end</i></code> to an array of
-<a href="#octet">octets</a> corresponding to the external format designated by <a href="#external-formats">external format</a> <code><i>external-format</i></code>. The defaults for
+<a href="#octet">octets</a> corresponding to the <a href="#external-formats">external
+format</a> designated by <code><i>external-format</i></code>. The defaults for
<code><i>start</i></code> and <code><i>end</i></code>
are <code>0</code> and the length of the string. The default
for <code><i>external-format</i></code> is <code>:LATIN1</code>.
@@ -995,9 +997,25 @@
<blockquote><br> Converts the Lisp
sequence <code><i>sequence</i></code> of <a href="#octet">octets</a>
from <code><i>start</i></code> to <code><i>end</i></code> to string
-using the external format designated
-by <a href="#external-formats">external
-format</a> <code><i>external-format</i></code>. The defaults for
+using the <a href="#external-formats">external format</a> designated
+by <code><i>external-format</i></code>. The defaults for
+<code><i>start</i></code> and <code><i>end</i></code>
+are <code>0</code> and the length of the sequence. The default
+for <code><i>external-format</i></code> is <code>:LATIN1</code>.
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="octet-length"><b>octet-length</b> <i>string <tt>&key</tt> external-format start end</i> => <i>length-or-nil</i></a>
+
+<blockquote><br>
+
+Returns the length of the substring of <code><i>string</i></code> from <code><i>start</i></code> to <code><i>end</i></code> in
+<a href="#octet">octets</a> if encoded using
+the <a href="#external-formats">external format</a> designated
+by <code><i>external-format</i></code>. Might return <code>NIL</code>
+if there's no efficient way to compute the length without iterating
+through the whole string.
+The defaults for
<code><i>start</i></code> and <code><i>end</i></code>
are <code>0</code> and the length of the sequence. The default
for <code><i>external-format</i></code> is <code>:LATIN1</code>.
@@ -1042,7 +1060,7 @@
his work on making FLEXI-STREAMS faster.
<p>
-$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.106 2008/05/21 01:06:45 edi Exp $
+$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.107 2008/05/21 01:43:45 edi Exp $
<p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
</body>
Modified: branches/edi/packages.lisp
==============================================================================
--- branches/edi/packages.lisp (original)
+++ branches/edi/packages.lisp Tue May 20 21:49:41 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.34 2008/05/20 23:44:45 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.35 2008/05/21 01:43:43 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -76,6 +76,7 @@
:make-in-memory-output-stream
:make-flexi-stream
:octet
+ :octet-length
:octets-to-string
:output-stream-sequence-length
:peek-byte
Modified: branches/edi/strings.lisp
==============================================================================
--- branches/edi/strings.lisp (original)
+++ branches/edi/strings.lisp Tue May 20 21:49:41 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.21 2008/05/20 09:04:23 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.22 2008/05/21 01:43:43 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -159,3 +159,15 @@
(incf j))
(setf (fill-pointer string) j)
string))))))))
+
+(defun octet-length (string &key (external-format :latin1) (start 0) (end (length string)))
+ "Returns the length of the substring of STRING from START to END in
+octets if encoded using the external format EXTERNAL-FORMAT. Might
+return NIL if there's no efficient way to compute the length without
+iterating through the whole string."
+ (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)))
+ (typecase factor
+ (fixnum (* factor (- end start))))))