Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/edicl-flexi-streams-20240429143708/stream.lisp

KindCoveredAll%
expression0107 0.0
branch020 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
2
 ;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.61 2008/05/19 22:32:56 edi Exp $
3
 
4
 ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
5
 
6
 ;;; Redistribution and use in source and binary forms, with or without
7
 ;;; modification, are permitted provided that the following conditions
8
 ;;; are met:
9
 
10
 ;;;   * Redistributions of source code must retain the above copyright
11
 ;;;     notice, this list of conditions and the following disclaimer.
12
 
13
 ;;;   * Redistributions in binary form must reproduce the above
14
 ;;;     copyright notice, this list of conditions and the following
15
 ;;;     disclaimer in the documentation and/or other materials
16
 ;;;     provided with the distribution.
17
 
18
 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19
 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20
 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21
 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22
 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23
 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24
 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25
 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26
 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
 
30
 (in-package :flexi-streams)
31
 
32
 (defclass flexi-stream (trivial-gray-stream-mixin)
33
   ((stream :initarg :stream
34
            :reader flexi-stream-stream
35
            :documentation "The actual stream that's used for
36
 input and/or output.  It must be capable of reading/writing
37
 octets with READ-SEQUENCE and/or WRITE-SEQUENCE.")
38
    (external-format :initform (make-external-format :iso-8859-1)
39
                     :initarg :flexi-stream-external-format
40
                     :accessor flexi-stream-external-format
41
                     :documentation "The encoding currently used
42
 by this stream.  Can be changed on the fly.")
43
    (element-type :initform 'char*
44
                  :initarg :element-type
45
                  :accessor flexi-stream-element-type
46
                  :documentation "The element type of this stream."))
47
   (:documentation "A FLEXI-STREAM object is a stream that's
48
 `layered' atop an existing binary/bivalent stream in order to
49
 allow for multi-octet external formats.  FLEXI-STREAM itself is a
50
 mixin and should not be instantiated."))
51
 
52
 (defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs)
53
   "Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain
54
 reasonable values."
55
   (declare #.*standard-optimize-settings*)
56
   (declare (ignore initargs))
57
   (with-accessors ((external-format flexi-stream-external-format)
58
                    (element-type flexi-stream-element-type))
59
       flexi-stream
60
     (unless (or (subtypep element-type 'character)
61
                 (subtypep element-type 'octet))
62
       (error 'flexi-stream-element-type-error
63
              :element-type element-type
64
              :stream flexi-stream))
65
     (setq external-format (maybe-convert-external-format external-format))))
66
 
67
 (defmethod (setf flexi-stream-external-format) :around (new-value (flexi-stream flexi-stream))
68
   "Converts the new value to an EXTERNAL-FORMAT object if
69
 necessary."
70
   (declare #.*standard-optimize-settings*)
71
   (call-next-method (maybe-convert-external-format new-value) flexi-stream))
72
 
73
 (defmethod (setf flexi-stream-element-type) :before (new-value (flexi-stream flexi-stream))
74
   "Checks whether the new value makes sense before it is set."
75
   (declare #.*standard-optimize-settings*)
76
   (unless (or (subtypep new-value 'character)
77
               (type-equal new-value 'octet))
78
     (error 'flexi-stream-element-type-error
79
            :element-type new-value
80
            :stream flexi-stream)))
81
 
82
 (defmethod stream-element-type ((stream flexi-stream))
83
   "Returns the element type that was provided by the creator of
84
 the stream."
85
   (declare #.*standard-optimize-settings*)
86
   (with-accessors ((element-type flexi-stream-element-type))
87
       stream
88
     element-type))
89
 
90
 (defmethod close ((stream flexi-stream) &key abort)
91
   "Closes the flexi stream by closing the underlying `real'
92
 stream."
93
   (declare #.*standard-optimize-settings*)
94
   (with-accessors ((stream flexi-stream-stream))
95
       stream
96
     (cond ((open-stream-p stream)
97
            (close stream :abort abort))
98
           (t nil))))
99
 
100
 (defmethod open-stream-p ((stream flexi-stream))
101
   "A flexi stream is open if its underlying stream is open."
102
   (declare #.*standard-optimize-settings*)
103
   (with-accessors ((stream flexi-stream-stream))
104
       stream
105
     (open-stream-p stream)))
106
 
107
 (defmethod stream-file-position ((stream flexi-stream))
108
   "Dispatch to method for underlying stream."
109
   (declare #.*standard-optimize-settings*)
110
   (with-accessors ((stream flexi-stream-stream))
111
       stream
112
     (file-position stream)))
113
 
114
 (defmethod (setf stream-file-position) (position-spec (stream flexi-stream))
115
   "Dispatch to method for underlying stream."
116
   (declare #.*standard-optimize-settings*)
117
   (with-accessors ((underlying-stream flexi-stream-stream))
118
       stream
119
     (if (file-position underlying-stream position-spec)
120
         (setf (flexi-stream-position stream) (file-position underlying-stream))
121
           nil)))
122
 
123
 (defclass flexi-output-stream (flexi-stream fundamental-binary-output-stream
124
                                             fundamental-character-output-stream)
125
   ((column :initform 0
126
            :accessor flexi-stream-column
127
            :documentation "The current output column.  A
128
 non-negative integer or NIL."))
129
   (:documentation "A FLEXI-OUTPUT-STREAM is a FLEXI-STREAM that
130
 can actually be instatiated and used for output.  Don't use
131
 MAKE-INSTANCE to create a new FLEXI-OUTPUT-STREAM but use
132
 MAKE-FLEXI-STREAM instead."))
133
 
134
 #+:cmu
135
 (defmethod input-stream-p ((stream flexi-output-stream))
136
   "Explicitly states whether this is an input stream."
137
   (declare #.*standard-optimize-settings*)
138
   nil)
139
 
140
 (defclass flexi-input-stream (flexi-stream fundamental-binary-input-stream
141
                                            fundamental-character-input-stream)
142
   ((last-char-code :initform nil
143
                    :accessor flexi-stream-last-char-code
144
                    :documentation "This slot either holds NIL or the
145
 last character \(code) read successfully.  This is mainly used for
146
 UNREAD-CHAR sanity checks.")
147
    (last-octet :initform nil
148
                :accessor flexi-stream-last-octet
149
                :documentation "This slot either holds NIL or the last
150
 octet read successfully from the stream using a `binary' operation
151
 such as READ-BYTE.  This is mainly used for UNREAD-BYTE sanity
152
 checks.")
153
    (octet-stack :initform nil
154
                 :accessor flexi-stream-octet-stack
155
                 :documentation "A small buffer which holds octets
156
 that were already read from the underlying stream but not yet
157
 used to produce characters.  This is mainly used if we have to
158
 look ahead for a CR/LF line ending.")
159
    (position :initform 0
160
              :initarg :position
161
              :type integer
162
              :accessor flexi-stream-position
163
              :documentation "The position within the stream where each
164
 octet read counts as one.")
165
    (bound :initform nil
166
           :initarg :bound
167
           :type (or null integer)
168
           :accessor flexi-stream-bound
169
           :documentation "When this is not NIL, it must be an integer
170
 and the stream will behave as if no more data is available as soon as
171
 POSITION is greater or equal than this value."))
172
   (:documentation "A FLEXI-INPUT-STREAM is a FLEXI-STREAM that
173
 can actually be instatiated and used for input.  Don't use
174
 MAKE-INSTANCE to create a new FLEXI-INPUT-STREAM but use
175
 MAKE-FLEXI-STREAM instead."))
176
 
177
 #+:cmu
178
 (defmethod output-stream-p ((stream flexi-input-stream))
179
   "Explicitly states whether this is an output stream."
180
   (declare #.*standard-optimize-settings*)
181
   nil)
182
 
183
 (defclass flexi-io-stream (flexi-input-stream flexi-output-stream)
184
   ()
185
   (:documentation "A FLEXI-IO-STREAM is a FLEXI-STREAM that can
186
 actually be instatiated and used for input and output.  Don't use
187
 MAKE-INSTANCE to create a new FLEXI-IO-STREAM but use
188
 MAKE-FLEXI-STREAM instead."))
189
 
190
 #+:cmu
191
 (defmethod input-stream-p ((stream flexi-io-stream))
192
   "Explicitly states whether this is an input stream."
193
   (declare #.*standard-optimize-settings*)
194
   t)
195
 
196
 #+:cmu
197
 (defmethod output-stream-p ((stream flexi-io-stream))
198
   "Explicitly states whether this is an output stream."
199
   (declare #.*standard-optimize-settings*)
200
   t)
201
 
202
 (defun make-flexi-stream (stream &rest args
203
                                  &key (external-format (make-external-format :iso-8859-1))
204
                                       element-type column position bound)
205
   "Creates and returns a new flexi stream.  STREAM must be an open
206
 binary or `bivalent' stream, i.e. it must be capable of
207
 reading/writing octets with READ-SEQUENCE and/or WRITE-SEQUENCE.  The
208
 resulting flexi stream is an input stream if and only if STREAM is an
209
 input stream.  Likewise, it's an output stream if and only if STREAM
210
 is an output stream.  The default for ELEMENT-TYPE is LW:SIMPLE-CHAR
211
 on LispWorks and CHARACTER on other Lisps.  EXTERNAL-FORMAT must be an
212
 EXTERNAL-FORMAT object or a symbol or a list denoting such an object.
213
 COLUMN is the initial column of the stream which is either a
214
 non-negative integer or NIL.  The COLUMN argument must only be used
215
 for output streams.  POSITION \(only used for input streams) should be
216
 an integer and it denotes the position the stream is in - it will be
217
 increased by one for each octet read.  BOUND \(only used for input
218
 streams) should be NIL or an integer.  If BOUND is not NIL and
219
 POSITION has gone beyond BOUND, then the stream will behave as if no
220
 more input is available."
221
   (declare #.*standard-optimize-settings*)
222
   ;; these arguments are ignored - they are only there to provide a
223
   ;; meaningful parameter list for IDEs
224
   (declare (ignore element-type column position bound))
225
   (unless (and (streamp stream)
226
                (open-stream-p stream))
227
     (error "~S should have been an open stream." stream))
228
   (apply #'make-instance
229
          ;; actual type depends on STREAM
230
          (cond ((and (input-stream-p stream)
231
                      (output-stream-p stream))
232
                 'flexi-io-stream)
233
                ((input-stream-p stream)
234
                 'flexi-input-stream)
235
                ((output-stream-p stream)
236
                 'flexi-output-stream)
237
                (t
238
                 (error "~S is neither an input nor an output stream." stream)))
239
          :stream stream
240
          :flexi-stream-external-format external-format
241
          (sans args :external-format)))