;;; 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))