[Common Lisp] [*scratch*] gray stream

なんかもうどうでもいいから、昔書いたコードをアップしたりする（笑

(defpackage :koto.iconv-stream
  (:nicknames :iconv-stream)
  (:use :cl :sb-gray)
  (:export
   :make-iconv-output-stream
   :make-iconv-input-stream
   ))

(in-package :iconv-stream)

(defclass iconv-stream-mixin ()
  ((external-format :initform "UTF-8" :initarg :external-format)
   (internal-format :initform "UTF-8" :initarg :internal-format)))

(defclass iconv-output-stream (fundamental-character-output-stream
                               iconv-stream-mixin)
  ((base-stream :initarg :base-stream)
   (buffer :initform (make-string 4096))
   (fill-pointer :initform 0)
   (column :initform 0)))

(defmethod stream-write-char ((stream iconv-output-stream) char)
  (with-slots (buffer fill-pointer column) stream
    (setf (schar buffer fill-pointer) char)
    (incf fill-pointer)
    (if (char= #\newline char)
        (setf column 0)
        (incf column))
    (if (= fill-pointer (length buffer))
        (force-output stream)))
  char)

(defmethod stream-line-column ((stream iconv-output-stream))
  (slot-value stream 'column))

(defmethod stream-force-output ((stream iconv-output-stream))
  (with-slots (buffer fill-pointer external-format internal-format base-stream)
      stream
    (unless (zerop fill-pointer)
      (let ((vector (sb-ext:string-to-octets buffer :end fill-pointer)))
        (write-sequence (iconv:iconv internal-format external-format vector)
                        base-stream))
      (setf fill-pointer 0)))
  nil)

(defmethod close ((stream iconv-output-stream) &key abort)
  (with-slots (base-stream) stream
    (stream-force-output stream)
    (close base-stream :abort abort)))

(defun make-iconv-output-stream (file external-format &key if-exists)
  (make-instance 'iconv-output-stream
                 :external-format external-format
                 :base-stream (open file
                                    :direction :output
                                    :if-exists if-exists
                                    :element-type '(unsigned-byte 8))))


(defclass iconv-input-stream (fundamental-character-input-stream
                              iconv-stream-mixin)
  ((base-stream :initarg :base-stream)
   (base-buffer :initform
                (make-array 4096
                            :element-type '(unsigned-byte 8)))
   (base-index :initform 0)
   (buffer :initform "")
   (index :initform 0)))

(defmethod stream-read-char ((stream iconv-input-stream))
  (with-slots (buffer index base-stream base-buffer base-index external-format
                      internal-format)
      stream
    (when (= index (length buffer))
      (let ((length (read-sequence base-buffer base-stream :start base-index)))
        (if (zerop length)
            (return-from stream-read-char :eof))
        (multiple-value-bind (out remain)
            (iconv:iconv external-format internal-format
                         (subseq base-buffer 0 length))
          (setf buffer (sb-ext:octets-to-string out)
                base-index (length remain)
                index 0)
          (loop for i from 0 below base-index
                do (setf (aref base-buffer i) (aref remain i))))))
    (prog1 (aref buffer index)
      (incf index))))

(defmethod stream-listen ((stream iconv-input-stream))
  (with-slots (buffer index) stream
    (< index (length buffer))))

(defmethod stream-unread-char ((stream iconv-input-stream) char)
  (with-slots (buffer index) stream
    (cond ((zerop index)
           (setf buffer (format nil "~a~a" char buffer)))
          (t
           (decf index)
           (setf (aref buffer index) char))))
  nil)

(defmethod stream-clear-input ((stream iconv-input-stream))
  (with-slots (buffer index base-index) stream
    (setf buffer ""
          index 0
          base-index 0))
  nil)

(defmethod stream-line-column ((stream iconv-input-stream))
  nil)

(defmethod close ((stream iconv-input-stream) &key abort)
  (with-slots (base-stream) stream
    (close base-stream :abort abort)))

(defun make-iconv-input-stream (file external-format)
  (make-instance 'iconv-input-stream
                 :external-format external-format
                 :base-stream (open file :element-type '(unsigned-byte 8))))