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 (defun %write-string (string)
  25   (#j:jqconsole:Write string "jqconsole-output"))
  26
  27 (defvar *standard-output*
  28   (vector 'stream
  29           (lambda (ch) (%write-string (string ch)))
  30           (lambda (string) (%write-string string))))
  31
  32 (defun streamp (x)
  33   (and (vectorp x) (eq (aref x 0) 'stream)))
  34
  35 (defun write-char (char &optional (stream *standard-output*))
  36   (funcall (aref stream 1) char))
  37
  38 (defun write-string (string &optional (stream *standard-output*))
  39   (funcall (aref stream 2) string))
  40
  41
  42 (defun make-string-output-stream ()
  43   (let ((buffer (make-string 0)))
  44     (vector 'stream
  45             ;; write-char
  46             (lambda (ch)
  47               (vector-push-extend ch buffer))
  48             (lambda (string)
  49               (dotimes (i (length string))
  50                 (vector-push-extend (aref string i) buffer)))
  51             'string-stream
  52             buffer)))
  53
  54 (defun get-output-stream-string (stream)
  55   (eq (aref stream 3) 'string-stream)
  56   (prog1 (aref stream 4)
  57     (aset stream 4 (make-string 0))))
  58
  59 (defmacro with-output-to-string ((var) &body body)
  60   `(let ((,var (make-string-output-stream)))
  61      ,@body
  62      (get-output-stream-string ,var)))