src/stream.lisp

   1 ;;; stream.lisp ---
   2
   3 ;; copyright (C) 2012, 2013 David Vazquez
   4 ;; Copyright (C) 2012 Raimon Grau
   5
   6 ;; JSCL is free software: you can redistribute it and/or
   7 ;; modify it under the terms of the GNU General Public License as
   8 ;; published by the Free Software Foundation, either version 3 of the
   9 ;; License, or (at your option) any later version.
  10 ;;
  11 ;; JSCL is distributed in the hope that it will be useful, but
  12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;; General Public License for more details.
  15 ;;
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 ;;; TODO: Use structures to represent streams, but we would need
  20 ;;; inheritance.
  21
  22 (/debug "loading stream.lisp!")
  23
  24 (defvar *standard-output*
  25   (vector 'stream
  26           (lambda (ch) (%write-string (string ch)))
  27           (lambda (string) (%write-string string))))
  28
  29 (defun streamp (x)
  30   (and (vectorp x) (eq (aref x 0) 'stream)))
  31
  32 (defun write-char (char &optional (stream *standard-output*))
  33   (funcall (aref stream 1) char))
  34
  35 (defun write-string (string &optional (stream *standard-output*))
  36   (funcall (aref stream 2) string))
  37
  38
  39 (defun make-string-output-stream ()
  40   (let ((buffer (make-string 0)))
  41     (vector 'stream
  42             ;; write-char
  43             (lambda (ch)
  44               (vector-push-extend ch buffer))
  45             (lambda (string)
  46               (dotimes (i (length string))
  47                 (vector-push-extend (aref string i) buffer)))
  48             'string-stream
  49             buffer)))
  50
  51 (defun get-output-stream-string (stream)
  52   (eq (aref stream 3) 'string-stream)
  53   (prog1 (aref stream 4)
  54     (aset stream 4 (make-string 0))))
  55
  56 (defmacro with-output-to-string ((var) &body body)
  57   `(let ((,var (make-string-output-stream)))
  58      ,@body
  59      (get-output-stream-string ,var)))