File: gray.lisp

package info (click to toggle)
cl-zip 20101107-2
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 112 kB
  • ctags: 97
  • sloc: lisp: 1,026; makefile: 13
file content (71 lines) | stat: -rw-r--r-- 2,118 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
(in-package :zip)

(defun default-external-format ()
  :utf-8)

(defun octets-to-string (octets ef)
  (with-output-to-string (out)
    (flexi-streams:with-input-from-sequence (in octets)
      (let ((in* (flexi-streams:make-flexi-stream in :external-format ef)))
	(loop
	    for c = (read-char in* nil nil)
	    while c
	    do (write-char c out))))))

(defun string-to-octets (string ef)
  (flexi-streams:with-output-to-sequence (out)
    (with-input-from-string (in string)
      (let ((out* (flexi-streams:make-flexi-stream out :external-format ef)))
	(loop
	    for c = (read-char in nil nil)
	    while c
	    do (write-char c out*))))))

(defclass buffer-output-stream
    (trivial-gray-stream-mixin fundamental-binary-output-stream)
    ((buf :initarg :buf :accessor buf)
     (pos :initform 0 :accessor pos)))

;; fallback method just in case the lisp doesn't have or doesn't use
;; stream-write-sequence:
(defmethod stream-write-byte
    ((stream buffer-output-stream) byte)
  (stream-write-sequence stream (vector byte) 0 1)
  byte)

(defmethod stream-write-sequence
    ((stream buffer-output-stream) seq start end &key)
  (replace (buf stream)
	   seq
	   :start1 (pos stream)
	   :start2 start
	   :end2 end)
  (incf (pos stream) (- end start))
  seq)

(defun make-buffer-output-stream (outbuf)
  (make-instance 'buffer-output-stream :buf outbuf))

(defclass truncating-stream
    (trivial-gray-stream-mixin fundamental-binary-input-stream)
    ((input-handle :initarg :input-handle :accessor input-handle)
     (size :initarg :size :accessor size)
     (pos :initform 0 :accessor pos)))

(defmethod stream-read-byte ((s truncating-stream))
  (if (< (pos s) (size s))
      (prog1
	  (read-byte (input-handle s))
	(incf (pos s)))
      nil))

(defmethod stream-read-sequence ((s truncating-stream) seq start end &key)
  (let* ((n (- end start))
        (max (- (size s) (pos s)))
        (result
         (read-sequence seq
                        (input-handle s)
                        :start start
                        :end (+ start (min n max)))))
    (incf (pos s) (- result start))
    result))