input.lisp - clic - Clic is an command line interactive client for gopher writt… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
input.lisp (13156B) | |
--- | |
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 1… | |
2 ;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.78 2008/05/2… | |
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 #-:lispworks | |
33 (defmethod read-byte* ((flexi-input-stream flexi-input-stream)) | |
34 "Reads one byte \(octet) from the underlying stream of | |
35 FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not | |
36 empty)." | |
37 (declare #.*standard-optimize-settings*) | |
38 ;; we're using S instead of STREAM here because of an | |
39 ;; issue with SBCL: | |
40 ;; <http://article.gmane.org/gmane.lisp.steel-bank.general/1386> | |
41 (with-accessors ((position flexi-stream-position) | |
42 (bound flexi-stream-bound) | |
43 (octet-stack flexi-stream-octet-stack) | |
44 (s flexi-stream-stream)) | |
45 flexi-input-stream | |
46 (declare (integer position) | |
47 (type (or null integer) bound)) | |
48 (when (and bound | |
49 (>= position bound)) | |
50 (return-from read-byte* nil)) | |
51 (incf position) | |
52 (or (pop octet-stack) | |
53 (read-byte s nil nil) | |
54 (progn (decf position) nil)))) | |
55 | |
56 #+:lispworks | |
57 (defmethod read-byte* ((flexi-input-stream flexi-input-stream)) | |
58 "Reads one byte \(octet) from the underlying \(binary) stream of | |
59 FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)." | |
60 (declare #.*standard-optimize-settings*) | |
61 (with-accessors ((position flexi-stream-position) | |
62 (bound flexi-stream-bound) | |
63 (octet-stack flexi-stream-octet-stack) | |
64 (stream flexi-stream-stream)) | |
65 flexi-input-stream | |
66 (declare (integer position) | |
67 (type (or null integer) bound)) | |
68 (when (and bound | |
69 (>= position bound)) | |
70 (return-from read-byte* nil)) | |
71 (incf position) | |
72 (or (pop octet-stack) | |
73 (read-byte stream nil nil) | |
74 (progn (decf position) nil)))) | |
75 | |
76 #+:lispworks | |
77 (defmethod read-byte* ((flexi-input-stream flexi-char-input-stream)) | |
78 "Reads one byte \(octet) from the underlying stream of | |
79 FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty). | |
80 Only used for LispWorks bivalent streams which aren't binary." | |
81 (declare #.*standard-optimize-settings*) | |
82 (with-accessors ((position flexi-stream-position) | |
83 (bound flexi-stream-bound) | |
84 (octet-stack flexi-stream-octet-stack) | |
85 (stream flexi-stream-stream)) | |
86 flexi-input-stream | |
87 (declare (integer position) | |
88 (type (or null integer) bound)) | |
89 (when (and bound | |
90 (>= position bound)) | |
91 (return-from read-byte* nil)) | |
92 (incf position) | |
93 (or (pop octet-stack) | |
94 ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all | |
95 ;; bivalent streams in LispWorks | |
96 (let* ((buffer (make-array 1 :element-type 'octet)) | |
97 (new-position (read-sequence buffer stream))) | |
98 (cond ((zerop new-position) | |
99 (decf position) nil) | |
100 (t (aref buffer 0))))))) | |
101 | |
102 (defmethod stream-clear-input ((flexi-input-stream flexi-input-stream)) | |
103 "Calls the corresponding method for the underlying input stream | |
104 and also clears the value of the OCTET-STACK slot." | |
105 (declare #.*standard-optimize-settings*) | |
106 ;; note that we don't reset the POSITION slot | |
107 (with-accessors ((octet-stack flexi-stream-octet-stack) | |
108 (stream flexi-stream-stream)) | |
109 flexi-input-stream | |
110 (setq octet-stack nil) | |
111 (clear-input stream))) | |
112 | |
113 (defmethod stream-listen ((flexi-input-stream flexi-input-stream)) | |
114 "Calls the corresponding method for the underlying input stream | |
115 but first checks if \(old) input is available in the OCTET-STACK | |
116 slot." | |
117 (declare #.*standard-optimize-settings*) | |
118 (with-accessors ((position flexi-stream-position) | |
119 (bound flexi-stream-bound) | |
120 (octet-stack flexi-stream-octet-stack) | |
121 (stream flexi-stream-stream)) | |
122 flexi-input-stream | |
123 (declare (integer position) | |
124 (type (or null integer) bound)) | |
125 (when (and bound | |
126 (>= position bound)) | |
127 (return-from stream-listen nil)) | |
128 (or octet-stack (listen stream)))) | |
129 | |
130 (defmethod stream-read-byte ((stream flexi-input-stream)) | |
131 "Reads one byte \(octet) from the underlying stream." | |
132 (declare #.*standard-optimize-settings*) | |
133 ;; set LAST-CHAR-CODE slot to NIL because we can't UNREAD-CHAR after | |
134 ;; this operation | |
135 (with-accessors ((last-char-code flexi-stream-last-char-code) | |
136 (last-octet flexi-stream-last-octet)) | |
137 stream | |
138 (setq last-char-code nil) | |
139 (let ((octet (read-byte* stream))) | |
140 (setq last-octet octet) | |
141 (or octet :eof)))) | |
142 | |
143 (defun unread-char% (char flexi-input-stream) | |
144 "Used internally to put a character CHAR which was already read back | |
145 on the stream. Uses the OCTET-STACK slot and decrements the POSITION | |
146 slot accordingly." | |
147 (declare #.*standard-optimize-settings*) | |
148 (with-accessors ((position flexi-stream-position) | |
149 (octet-stack flexi-stream-octet-stack) | |
150 (external-format flexi-stream-external-format)) | |
151 flexi-input-stream | |
152 (let ((counter 0) octets-reversed) | |
153 (declare (fixnum counter)) | |
154 (flet ((writer (octet) | |
155 (incf counter) | |
156 (push octet octets-reversed))) | |
157 (declare (dynamic-extent (function writer))) | |
158 (char-to-octets external-format char #'writer) | |
159 (decf position counter) | |
160 (setq octet-stack (nreconc octets-reversed octet-stack)))))) | |
161 | |
162 (defmethod stream-read-char ((stream flexi-input-stream)) | |
163 (declare #.*standard-optimize-settings*) | |
164 ;; note that we do nothing for the :LF EOL style because we assume | |
165 ;; that #\Newline is the same as #\Linefeed in all Lisps which will | |
166 ;; use this library | |
167 (with-accessors ((external-format flexi-stream-external-format) | |
168 (last-octet flexi-stream-last-octet) | |
169 (last-char-code flexi-stream-last-char-code)) | |
170 stream | |
171 ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after | |
172 ;; this operation | |
173 (setq last-octet nil) | |
174 (flet ((reader () | |
175 (read-byte* stream)) | |
176 (unreader (char) | |
177 (unread-char% char stream))) | |
178 (declare (dynamic-extent (function reader) (function unreader))) | |
179 (let* ((*current-unreader* #'unreader) | |
180 (char-code (or (octets-to-char-code external-format #'reade… | |
181 (return-from stream-read-char :eof)))) | |
182 ;; remember this character and its char code for UNREAD-CHAR | |
183 (setq last-char-code char-code) | |
184 (or (code-char char-code) char-code))))) | |
185 | |
186 (defmethod stream-read-char-no-hang ((stream flexi-input-stream)) | |
187 "Reads one character if the underlying stream has at least one | |
188 octet available." | |
189 (declare #.*standard-optimize-settings*) | |
190 ;; note that this may block for non-8-bit encodings - I think | |
191 ;; there's no easy way to handle this correctly | |
192 (and (stream-listen stream) | |
193 (stream-read-char stream))) | |
194 | |
195 (defmethod stream-read-sequence ((flexi-input-stream flexi-input-stream)… | |
196 "An optimized version which uses a buffer underneath. The function | |
197 can deliver characters as well as octets and it decides what to do | |
198 based on the element type of the sequence \(which takes precedence) | |
199 and the element type of the stream. What you'll really get might also | |
200 depend on your Lisp. Some of the implementations are more picky than | |
201 others - see for example FLEXI-STREAMS-TEST::SEQUENCE-TEST." | |
202 (declare #.*standard-optimize-settings*) | |
203 (declare (fixnum start end)) | |
204 (with-accessors ((octet-stack flexi-stream-octet-stack) | |
205 (external-format flexi-stream-external-format) | |
206 (last-octet flexi-stream-last-octet) | |
207 (last-char-code flexi-stream-last-char-code) | |
208 (element-type flexi-stream-element-type) | |
209 (stream flexi-stream-stream) | |
210 (position flexi-stream-position)) | |
211 flexi-input-stream | |
212 (when (>= start end) | |
213 (return-from stream-read-sequence start)) | |
214 (when (or (typep sequence | |
215 '(and vector | |
216 (not string) | |
217 (not (vector t)))) | |
218 (and (not (stringp sequence)) | |
219 (type-equal element-type 'octet))) | |
220 ;; if binary data is requested, just read from the underlying | |
221 ;; stream directly and skip the rest (but flush octet stack | |
222 ;; first) | |
223 (let ((index start)) | |
224 (declare (fixnum index)) | |
225 (when octet-stack | |
226 (replace sequence octet-stack :start1 start :end1 end) | |
227 (let ((octets-flushed (min (length octet-stack) (- end start))… | |
228 (incf index octets-flushed) | |
229 (setq octet-stack (nthcdr octets-flushed octet-stack)))) | |
230 (setq index (read-sequence sequence stream :start index :end end… | |
231 (when (> index start) | |
232 (setq last-char-code nil | |
233 last-octet (elt sequence (1- index)))) | |
234 (incf position (- index start)) | |
235 (return-from stream-read-sequence index))) | |
236 ;; otherwise hand over to the external format to do the work | |
237 (read-sequence* external-format flexi-input-stream sequence start en… | |
238 | |
239 (defmethod stream-unread-char ((stream flexi-input-stream) char) | |
240 "Implements UNREAD-CHAR for streams of type FLEXI-INPUT-STREAM. | |
241 Makes sure CHAR will only be unread if it was the last character | |
242 read and if it was read with the same encoding that's currently | |
243 being used by the stream." | |
244 (declare #.*standard-optimize-settings*) | |
245 (with-accessors ((last-char-code flexi-stream-last-char-code)) | |
246 stream | |
247 (unless last-char-code | |
248 (error 'flexi-stream-error | |
249 :stream stream | |
250 :format-control "No character to unread from this stream \(… | |
251 (unless (= (char-code char) last-char-code) | |
252 (error 'flexi-stream-error | |
253 :stream stream | |
254 :format-control "Last character read (~S) was different fro… | |
255 :format-arguments (list (code-char last-char-code) char))) | |
256 (unread-char% char stream) | |
257 (setq last-char-code nil) | |
258 nil)) | |
259 | |
260 (defmethod unread-byte (byte (flexi-input-stream flexi-input-stream)) | |
261 "Similar to UNREAD-CHAR in that it `unreads' the last octet from | |
262 STREAM. Note that you can only call UNREAD-BYTE after a corresponding | |
263 READ-BYTE." | |
264 (declare #.*standard-optimize-settings*) | |
265 (with-accessors ((last-octet flexi-stream-last-octet) | |
266 (octet-stack flexi-stream-octet-stack) | |
267 (position flexi-stream-position)) | |
268 flexi-input-stream | |
269 (unless last-octet | |
270 (error 'flexi-stream-error | |
271 :stream stream | |
272 :format-control "No byte to unread from this stream \(or la… | |
273 (unless (= byte last-octet) | |
274 (error 'flexi-stream-error | |
275 :stream stream | |
276 :format-control "Last byte read was different from #x~X." | |
277 :format-arguments (list byte))) | |
278 (setq last-octet nil) | |
279 (decf (the integer position)) | |
280 (push byte octet-stack) | |
281 nil)) | |
282 | |
283 (defmethod peek-byte ((flexi-input-stream flexi-input-stream) | |
284 &optional peek-type (eof-error-p t) eof-value) | |
285 "Returns an octet from FLEXI-INPUT-STREAM without actually removing it… | |
286 (declare #.*standard-optimize-settings*) | |
287 (loop for octet = (read-byte flexi-input-stream eof-error-p :eof) | |
288 until (cond ((eq octet :eof) | |
289 (return eof-value)) | |
290 ((null peek-type)) | |
291 ((eq peek-type t) | |
292 (plusp octet)) | |
293 ((= octet peek-type))) | |
294 finally (unread-byte octet flexi-input-stream) | |
295 (return octet))) |