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 (defvar *standard-output*)
  23
  24 (defun streamp (x)
  25   (and (vectorp x) (eq (aref x 0) 'stream)))
  26
  27 (defun make-string-output-stream ()
  28   (let ((buffer (make-string 0)))
  29     (vector 'stream
  30             ;; write-char
  31             (lambda (ch)
  32               (vector-push-extend ch buffer))
  33             'string-stream
  34             buffer)))
  35
  36 (defun get-output-stream-string (stream)
  37   (eq (aref stream 2) 'string-stream)
  38   (prog1 (aref stream 3)
  39     (aset stream 3 (make-string 0))))
  40
  41 (defun write-char (char &optional (stream *standard-output*))
  42   (funcall (aref stream 1) char))
  43
  44 (defmacro with-output-to-string ((var) &body body)
  45   `(let ((,var (make-string-output-stream)))
  46      ,@body
  47      (get-output-stream-string ,var)))