external/ch-util/src/bytebuffer.cl

   1
   2 (in-package :ch-util)
   3
   4 (defclass byte-buffer ()
   5   ((storage :accessor storage
   6             :initform (make-array '(256)
   7                                   :element-type '(unsigned-byte 8)
   8                                   :fill-pointer 0
   9                                   :adjustable t))
  10    (chunk-size :accessor chunk-size :initform 256)))
  11
  12 (defun byte-buffer ()
  13   (make-instance 'byte-buffer))
  14
  15 (defgeneric append-byte (buf byte))
  16 (defmethod append-byte ((buf byte-buffer) byte)
  17   (let* ((a (storage buf))
  18          (l (first (array-dimensions a)))
  19          (fp (fill-pointer a)))
  20     (when (= l fp)
  21       (let ((newlen (+ l (chunk-size buf))))
  22         (adjust-array a (list newlen))))
  23     (setf (aref a (1- (incf (fill-pointer a)))) byte)))
  24
  25 (defgeneric print-buffer (buf))
  26 (defmethod print-buffer ((buf byte-buffer))
  27   (let* ((a (storage buf))
  28          (fp (fill-pointer a)))
  29     (dotimes (i fp)
  30       (princ (code-char (aref a i))))))
  31
  32 (defun read-file-to-buffer (filename)
  33   (let ((buf (byte-buffer)))
  34     (with-open-file (f filename :element-type '(unsigned-byte 8))
  35       (do ((b (read-byte f) (read-byte f nil 'eof)))
  36           ((eq b 'eof))
  37         (append-byte buf b)))
  38     buf))
  39
  40 (defun contents-of-stream (in)
  41   "Returns a string with the entire contents of the specified file."
  42   (with-output-to-string (contents)
  43                          (let* ((buffer-size 4096)
  44                                 (buffer (make-string buffer-size)))
  45                            (labels ((read-chunks ()
  46                                       (let ((size (read-sequence buffer in)))
  47                                         (if (< size buffer-size)
  48                                             (princ (subseq buffer 0 size) contents)
  49                                             (progn
  50                                               (princ buffer contents)
  51                                               (read-chunks))))))
  52                              (read-chunks)))))
  53
  54 ;;;
  55 ;;; From lemonodor.com
  56 ;;; John Wiseman's blog
  57 ;;;
  58 (defun contents-of-file (pathname)
  59   (with-open-file (in pathname :direction :input)
  60     (contents-of-stream in)))