/[cmucl]/src/code/stream.lisp
ViewVC logotype

Diff of /src/code/stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.71 by emarsden, Wed Apr 7 11:03:38 2004 UTC revision 1.72 by emarsden, Wed Apr 7 17:15:00 2004 UTC
# Line 1222  streams." Line 1222  streams."
1222      (setf (concatenated-stream-streams stream) (cdr current))))      (setf (concatenated-stream-streams stream) (cdr current))))
1223    
1224  (defun concatenated-misc (stream operation &optional arg1 arg2)  (defun concatenated-misc (stream operation &optional arg1 arg2)
1225    (let ((left (concatenated-stream-streams stream)))    (let ((current (first (concatenated-stream-streams stream))))
1226      (when left      (case operation
1227        (let* ((current (car left)))        (:listen
1228          (case operation         (if current
1229            (:listen             (loop
1230             (loop              (let ((stuff (if (lisp-stream-p current)
1231               (let ((stuff (if (lisp-stream-p current)                               (funcall (lisp-stream-misc current) current
1232                                (funcall (lisp-stream-misc current) current                                        :listen)
1233                                         :listen)                               (stream-misc-dispatch current :listen))))
1234                                (stream-misc-dispatch current :listen))))                (cond ((eq stuff :eof)
1235                 (cond ((eq stuff :eof)                       ;; Advance current, and try again.
1236                        ;; Advance current, and try again.                       (pop (concatenated-stream-streams stream))
1237                        (pop (concatenated-stream-streams stream))                       (setf current (first (concatenated-stream-streams stream)))
1238                        (setf current                       (unless current (return :eof)))
1239                              (car (concatenated-stream-streams stream)))                      (stuff
1240                        (unless current                       ;; Stuff's available.
1241                          ;; No further streams.  EOF.                       (return t))
1242                          (return :eof)))                      (t
1243                       (stuff                       ;; Nothing available yet.
1244                        ;; Stuff's available.                       (return nil)))))
1245                        (return t))             :eof))
1246                       (t        (:close
1247                        ;; Nothing available yet.         (set-closed-flame stream))
1248                        (return nil))))))        (:clear-input
1249            (:close         (when current (clear-input current)))
1250             (set-closed-flame stream))        (:unread
1251            (:clear-input (clear-input current))         (when current (unread-char arg1 current)))
1252            (:unread (unread-char arg1 current))        (t
1253            (t         (if (lisp-stream-p current)
1254             (if (lisp-stream-p current)             (funcall (lisp-stream-misc current) current operation arg1 arg2)
1255                 (funcall (lisp-stream-misc current) current operation arg1 arg2)             (stream-misc-dispatch current operation arg1 arg2))))))
                (stream-misc-dispatch current operation arg1 arg2))))))))  
1256    
1257    
1258  ;;;; Echo Streams:  ;;;; Echo Streams:

Legend:
Removed from v.1.71  
changed lines
  Added in v.1.72

  ViewVC Help
Powered by ViewVC 1.1.5