Changeset 442

Timestamp:

Jan 30, 2004, 3:57:36 PM (21 years ago)

Author:

Gary Byers

Message:

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

File:

• trunk/ccl/level-1/l1-sysio.lisp (modified) (3 diffs)

trunk/ccl/level-1/l1-sysio.lisp

@@ -498 +498 @@
                          class
                          external-format)
+
   (let* ((temp-name nil)
          (pathname (pathname filename)))
@@ -511 +512 @@
                  (setq element-type '(unsigned-byte 8))))))
       (case direction
-        (:probe (setq if-exists :ignored if-does-not-exist nil))
+        (:probe (setq if-exists :ignored))
         (:input (setq if-exists :ignored))
         ((:io :output) nil)
@@ -614 +615 @@
 
 (defun stream-external-format (stream)
-  (require-type stream 'file-stream)
-  (file-stream-external-format stream))
+  (etypecase stream
+    (file-stream (file-stream-external-format stream))
+    (broadcast-stream (let* ((last (last-broadcast-stream stream)))
+                        (if last
+                          (stream-external-format last)
+                          :default)))))
 
 ;;; Under the circumstances, this is a very slow way of saying
 ;;; "we don't support EXTENDED-CHARs".
 (defun file-string-length (stream object)
-  (unless (and (typep stream 'file-stream)
-               (let* ((eltype (stream-element-type stream)))
-                 (or (eq 'character eltype)
-                     (eq 'base-char eltype)
-                     (subtypep eltype 'character))))
-    (error "~S is not a file stream capable of character output" stream))
-  (etypecase object
-    (character 1)
-    (string (length object))))
-
+  (if (typep stream 'broadcast-stream)
+    (let* ((last (last-broadcast-stream stream)))
+      (if last
+        (file-string-length last object)
+        1))
+    (progn
+      (unless (and (typep stream 'file-stream)
+                   (let* ((eltype (stream-element-type stream)))
+                     (or (eq 'character eltype)
+                         (eq 'base-char eltype)
+                         (subtypep eltype 'character))))
+        (error "~S is not a file stream capable of character output" stream))
+      (etypecase object
+        (character 1)
+        (string (length object))))))
+