Changeset 8921


Ignore:
Timestamp:
04/11/05 22:34:35 (16 years ago)
Author:
piso
Message:

WITH-OUTPUT-TO-STRING.16

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/with-output-to-string.lisp

    r5643 r8921  
    11;;; with-output-to-string.lisp
    22;;;
    3 ;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: with-output-to-string.lisp,v 1.1 2004-02-01 16:48:13 piso Exp $
     3;;; Copyright (C) 2003-2005 Peter Graves
     4;;; $Id: with-output-to-string.lisp,v 1.2 2005-04-11 22:34:35 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1818;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1919
    20 (in-package "SYSTEM")
     20(in-package #:system)
    2121
    22 ;;; From CMUCL.
    23 (defmacro with-output-to-string ((var &optional string &key element-type)
     22;;; From SBCL.
     23(defmacro with-output-to-string ((var &optional string &key (element-type ''character))
    2424         &body body)
    2525  "If STRING is specified, it must be a string with a fill pointer;
    2626   the output is incrementally appended to the string (as if by use of
    2727   VECTOR-PUSH-EXTEND)."
    28   (declare (ignore element-type))
    2928  (multiple-value-bind (forms decls) (parse-body body)
    3029    (if string
    31         `(let ((,var (make-fill-pointer-output-stream ,string)))
     30        (let ((ignored (gensym)))
     31          `(let ((,var (make-fill-pointer-output-stream ,string))
     32                 (,ignored ,element-type))
     33             (declare (ignore ,ignored))
     34             ,@decls
     35             (unwind-protect
     36                 (progn ,@forms)
     37               (close ,var))))
     38        `(let ((,var (make-string-output-stream :element-type ,element-type)))
    3239           ,@decls
    3340           (unwind-protect
    34             (progn ,@forms)
    35             (close ,var)))
    36         `(let ((,var (make-string-output-stream)))
    37            ,@decls
    38            (unwind-protect
    39             (progn ,@forms)
    40             (close ,var))
     41               (progn ,@forms)
     42             (close ,var))
    4143           (get-output-stream-string ,var)))))
Note: See TracChangeset for help on using the changeset viewer.