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

Contents of /zip/gray.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations)
Wed Apr 12 20:29:35 2006 UTC (8 years ago) by dlichteblau
Branch: MAIN
Changes since 1.5: +2 -1 lines
fixed buffer-output-stream
1 dlichteblau 1.1 (in-package :zip)
2    
3 dlichteblau 1.5 (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 dlichteblau 1.6 (defclass buffer-output-stream
25     (trivial-gray-stream-mixin fundamental-binary-output-stream)
26 dlichteblau 1.1 ((buf :initarg :buf :accessor buf)
27     (pos :initform 0 :accessor pos)))
28    
29     (defmethod stream-write-sequence
30 dlichteblau 1.5 ((stream buffer-output-stream) seq start end &key)
31     (replace (buf stream)
32     seq
33 dlichteblau 1.1 :start1 (pos stream)
34     :start2 start
35 dlichteblau 1.4 :end2 end)
36     (incf (pos stream) (- end start))
37     seq)
38 dlichteblau 1.1
39     (defun make-buffer-output-stream (outbuf)
40     (make-instance 'buffer-output-stream :buf outbuf))
41    
42 dlichteblau 1.5 (defclass truncating-stream
43     (trivial-gray-stream-mixin fundamental-binary-input-stream)
44 dlichteblau 1.1 ((input-handle :initarg :input-handle :accessor input-handle)
45     (size :initarg :size :accessor size)
46     (pos :initform 0 :accessor pos)))
47    
48     (defmethod stream-read-byte ((s truncating-stream))
49     (if (< (pos s) (size s))
50     (prog1
51     (read-byte (input-handle s))
52     (incf (pos s)))
53     nil))
54    
55 dlichteblau 1.5 (defmethod stream-read-sequence ((s truncating-stream) seq start end &key)
56 dlichteblau 1.1 (let* ((n (- end start))
57     (max (- (size s) (pos s)))
58     (result
59     (read-sequence (input-handle s)
60     seq
61     :start start
62     :end (+ start (min n max)))))
63     (incf (pos s) (- result start))
64     result))

  ViewVC Help
Powered by ViewVC 1.1.5