/[zip]/zip/gray.lisp
ViewVC logotype

Contents of /zip/gray.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Mon Aug 14 07:52:13 2006 UTC (7 years, 8 months ago) by dlichteblau
Branch: MAIN
CVS Tags: HEAD
Changes since 1.7: +6 -6 lines
From: Edi Weitz <edi@agharta.de>
Subject: Typo in STREAM-READ-SEQUENCE  (Was: NIL vs. :UNSPECIFIC)
1 (in-package :zip)
2
3 (defun default-external-format ()
4 :utf-8)
5
6 (defun octets-to-string (octets ef)
7 (with-output-to-string (out)
8 (flexi-streams:with-input-from-sequence (in octets)
9 (let ((in* (flexi-streams:make-flexi-stream in :external-format ef)))
10 (loop
11 for c = (read-char in* nil nil)
12 while c
13 do (write-char c out))))))
14
15 (defun string-to-octets (string ef)
16 (flexi-streams:with-output-to-sequence (out)
17 (with-input-from-string (in string)
18 (let ((out* (flexi-streams:make-flexi-stream out :external-format ef)))
19 (loop
20 for c = (read-char in nil nil)
21 while c
22 do (write-char c out*))))))
23
24 (defclass buffer-output-stream
25 (trivial-gray-stream-mixin fundamental-binary-output-stream)
26 ((buf :initarg :buf :accessor buf)
27 (pos :initform 0 :accessor pos)))
28
29 ;; fallback method just in case the lisp doesn't have or doesn't use
30 ;; stream-write-sequence:
31 (defmethod stream-write-byte
32 ((stream buffer-output-stream) byte)
33 (stream-write-sequence stream (vector byte) 0 1)
34 byte)
35
36 (defmethod stream-write-sequence
37 ((stream buffer-output-stream) seq start end &key)
38 (replace (buf stream)
39 seq
40 :start1 (pos stream)
41 :start2 start
42 :end2 end)
43 (incf (pos stream) (- end start))
44 seq)
45
46 (defun make-buffer-output-stream (outbuf)
47 (make-instance 'buffer-output-stream :buf outbuf))
48
49 (defclass truncating-stream
50 (trivial-gray-stream-mixin fundamental-binary-input-stream)
51 ((input-handle :initarg :input-handle :accessor input-handle)
52 (size :initarg :size :accessor size)
53 (pos :initform 0 :accessor pos)))
54
55 (defmethod stream-read-byte ((s truncating-stream))
56 (if (< (pos s) (size s))
57 (prog1
58 (read-byte (input-handle s))
59 (incf (pos s)))
60 nil))
61
62 (defmethod stream-read-sequence ((s truncating-stream) seq start end &key)
63 (let* ((n (- end start))
64 (max (- (size s) (pos s)))
65 (result
66 (read-sequence seq
67 (input-handle s)
68 :start start
69 :end (+ start (min n max)))))
70 (incf (pos s) (- result start))
71 result))

  ViewVC Help
Powered by ViewVC 1.1.5