source: cl-darcs/tags/0.1.0/binary-text.lisp

Last change on this file was 1, checked in by Magnus Henoch, 16 years ago

Initial import

File size: 1.7 KB
Line 
1;;; Copyright (C) 2006 Magnus Henoch
2;;;
3;;; This program is free software; you can redistribute it and/or
4;;; modify it under the terms of the GNU General Public License as
5;;; published by the Free Software Foundation; either version 2 of the
6;;; License, or (at your option) any later version.
7;;;
8;;; This program is distributed in the hope that it will be useful,
9;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11;;; General Public License for more details.
12;;;
13;;; You should have received a copy of the GNU General Public License
14;;; along with this program; if not, write to the Free Software
15;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
16
17(in-package :darcs)
18
19;; This is a wrapper stream that reads from a binary stream and
20;; returns the data as characters with as little change as possible.
21;; Specifically, only 10 is treated as newline, and byte values are
22;; not translated between any charsets.
23
24(defclass binary-text-input
25    (trivial-gray-streams:fundamental-character-input-stream)
26  ((stream :initarg :base-stream)
27   (unread :initform nil)))
28
29(defmethod trivial-gray-streams:stream-read-char ((stream
30                                                   binary-text-input))
31  (or (pop (slot-value stream 'unread))
32      (let ((byte (read-byte (slot-value stream 'stream) nil :eof)))
33        (case byte
34          (:eof
35           :eof)
36          (10
37           #\Newline)
38          (t
39           (code-char byte))))))
40
41(defmethod trivial-gray-streams:stream-unread-char ((stream
42                                                     binary-text-input)
43                                                    char)
44  (push char (slot-value stream 'unread)))
45
46(defmethod close ((stream binary-text-input) &key abort)
47  "Close the wrapped stream."
48  (close (slot-value stream 'stream) :abort abort)
49  (call-next-method))
Note: See TracBrowser for help on using the repository browser.