0.8.3.17:

[sbcl.git] / contrib / sb-simple-streams / cl.lisp

diff --git a/contrib/sb-simple-streams/cl.lisp b/contrib/sb-simple-streams/cl.lisp
index c9b4603..0df60ea 100644 (file)
--- a/contrib/sb-simple-streams/cl.lisp
+++ b/contrib/sb-simple-streams/cl.lisp
@@ -350,7 +350,7 @@
       ;; single-channel-simple-stream
       (with-stream-class (single-channel-simple-stream stream)
        (let ((ptr (sm buffpos stream)))
-         (when (>= ptr (sm buffer-ptr stream))
+         (when (>= ptr (sm buf-len stream))
            (setf ptr (sc-flush-buffer stream t)))
           (add-stream-instance-flags stream :dirty)
          (setf (sm buffpos stream) (1+ ptr))
@@ -397,7 +397,31 @@
       ((or (simple-array (unsigned-byte 8) (*))
           (simple-array (signed-byte 8) (*)))
        ;; "write-vector" equivalent
-       (error "implement me")
+       (simple-stream-dispatch stream
+         ;; single-channel-simple-stream
+         (with-stream-class (single-channel-simple-stream stream)
+           (loop with max-ptr = (sm buf-len stream)
+                 with real-end = (or end (length seq))
+                 for src-pos = start then (+ src-pos count)
+                 for src-rest = (- real-end src-pos)
+                 while (> src-rest 0) ; FIXME: this is non-ANSI
+                 for ptr = (let ((ptr (sm buffpos stream)))
+                             (if (>= ptr max-ptr)
+                                 (sc-flush-buffer stream t)
+                                 ptr))
+                 for buf-rest = (- max-ptr ptr)
+                 for count = (min buf-rest src-rest)
+                 do (progn (add-stream-instance-flags stream :dirty)
+                           (setf (sm buffpos stream) (+ ptr count))
+                           (buffer-copy seq src-pos (sm buffer stream) ptr count))))
+         ;; dual-channel-simple-stream
+         (error "Implement me")
+         ;; string-simple-stream
+         (error 'simple-type-error
+                :datum stream
+                :expected-type 'stream
+                :format-control "Can't write-byte on string streams."
+                :format-arguments '()))
        ))))
 
 
@@ -614,7 +638,7 @@
      nil)))
 
 (defun (setf interactive-stream-p) (flag stream)
-  (etypecase stream
+  (typecase stream
     (simple-stream
      (if flag
          (add-stream-instance-flags stream :interactive)
@@ -1058,18 +1082,6 @@
      (progn (sb-impl::stream-must-be-associated-with-file stream)
             (funcall (sb-kernel:ansi-stream-misc stream) stream :file-length)))))
 
-(defun line-length (&optional (stream *standard-output*))
-  "Returns the number of characters that will fit on a line of output on the
-  given Stream, or Nil if that information is not available."
-  (let ((stream (sb-impl::out-synonym-of stream)))
-    (etypecase stream
-      (simple-stream
-       (%simple-stream-line-length stream))
-      (ansi-stream
-       (funcall (sb-kernel:ansi-stream-misc stream) stream :line-length))
-      (fundamental-stream
-       (sb-gray:stream-line-length stream)))))
-
 (defun charpos (&optional (stream *standard-output*))
   "Returns the number of characters on the current line of output of the given
   Stream, or Nil if that information is not availible."