Ignore:
Timestamp:
Jan 30, 2004, 11:57:36 PM (16 years ago)
Author:
gb
Message:

Handle BROADCAST-STREAMs, error out on other non-FILE-STREAMs.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-sysio.lisp

    r425 r442  
    498498                         class
    499499                         external-format)
     500
    500501  (let* ((temp-name nil)
    501502         (pathname (pathname filename)))
     
    511512                 (setq element-type '(unsigned-byte 8))))))
    512513      (case direction
    513         (:probe (setq if-exists :ignored if-does-not-exist nil))
     514        (:probe (setq if-exists :ignored))
    514515        (:input (setq if-exists :ignored))
    515516        ((:io :output) nil)
     
    614615
    615616(defun stream-external-format (stream)
    616   (require-type stream 'file-stream)
    617   (file-stream-external-format stream))
     617  (etypecase stream
     618    (file-stream (file-stream-external-format stream))
     619    (broadcast-stream (let* ((last (last-broadcast-stream stream)))
     620                        (if last
     621                          (stream-external-format last)
     622                          :default)))))
    618623
    619624;;; Under the circumstances, this is a very slow way of saying
    620625;;; "we don't support EXTENDED-CHARs".
    621626(defun file-string-length (stream object)
    622   (unless (and (typep stream 'file-stream)
    623                (let* ((eltype (stream-element-type stream)))
    624                  (or (eq 'character eltype)
    625                      (eq 'base-char eltype)
    626                      (subtypep eltype 'character))))
    627     (error "~S is not a file stream capable of character output" stream))
    628   (etypecase object
    629     (character 1)
    630     (string (length object))))
    631 
     627  (if (typep stream 'broadcast-stream)
     628    (let* ((last (last-broadcast-stream stream)))
     629      (if last
     630        (file-string-length last object)
     631        1))
     632    (progn
     633      (unless (and (typep stream 'file-stream)
     634                   (let* ((eltype (stream-element-type stream)))
     635                     (or (eq 'character eltype)
     636                         (eq 'base-char eltype)
     637                         (subtypep eltype 'character))))
     638        (error "~S is not a file stream capable of character output" stream))
     639      (etypecase object
     640        (character 1)
     641        (string (length object))))))
     642 
Note: See TracChangeset for help on using the changeset viewer.