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

;;; Copyright (C) 2006 Magnus Henoch
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

(in-package :darcs)

;; This is a wrapper stream that reads from a binary stream and
;; returns the data as characters with as little change as possible.
;; Specifically, only 10 is treated as newline, and byte values are
;; not translated between any charsets.

(defclass binary-text-input
    (trivial-gray-streams:fundamental-character-input-stream)
  ((stream :initarg :base-stream)
   (unread :initform nil)))

(defmethod trivial-gray-streams:stream-read-char ((stream
                                                   binary-text-input))
  (or (pop (slot-value stream 'unread))
      (let ((byte (read-byte (slot-value stream 'stream) nil :eof)))
        (case byte
          (:eof
           :eof)
          (10
           #\Newline)
          (t
           (code-char byte))))))

(defmethod trivial-gray-streams:stream-unread-char ((stream
                                                     binary-text-input)
                                                    char)
  (push char (slot-value stream 'unread)))

(defmethod close ((stream binary-text-input) &key abort)
  "Close the wrapped stream."
  (close (slot-value stream 'stream) :abort abort)
  (call-next-method))