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

Diff of /src/code/fd-stream.lisp

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

revision 1.23.1.1 by ram, Tue Feb 23 16:08:20 1993 UTC revision 1.23.1.2 by ram, Tue Feb 23 16:12:10 1993 UTC
# Line 626  Line 626 
626                             (* length vm:byte-bits))                             (* length vm:byte-bits))
627      string))      string))
628    
 ;;; FD-STREAM-READ-LINE -- internal  
 ;;;  
 ;;;   Reads a line, returning a simple string. Note: this relies on the fact  
 ;;; that the input buffer does not change during do-input.  
 ;;;  
 (defun fd-stream-read-line (stream eof-error-p eof-value)  
   (let ((eof t))  
     (values  
      (or (let ((sap (fd-stream-ibuf-sap stream))  
                (results (when (fd-stream-unread stream)  
                           (prog1  
                               (list (string (fd-stream-unread stream)))  
                             (setf (fd-stream-unread stream) nil)  
                             (setf (fd-stream-listen stream) nil)))))  
            (catch 'eof-input-catcher  
              (loop  
                (input-at-least stream 1)  
                (let* ((head (fd-stream-ibuf-head stream))  
                       (tail (fd-stream-ibuf-tail stream))  
                       (newline (do ((index head (1+ index)))  
                                    ((= index tail) nil)  
                                  (when (= (sap-ref-8 sap index)  
                                           (char-code #\newline))  
                                    (return index))))  
                       (end (or newline tail)))  
                  (push (string-from-sap sap head end)  
                        results)  
   
                  (when newline  
                    (setf eof nil)  
                    (setf (fd-stream-ibuf-head stream)  
                          (1+ newline))  
                    (return))  
                  (setf (fd-stream-ibuf-head stream) end))))  
            (cond ((null results)  
                   nil)  
                  ((null (cdr results))  
                   (car results))  
                  (t  
                   (apply #'concatenate 'simple-string (nreverse results)))))  
          (if eof-error-p  
              (error "EOF while reading ~S" stream)  
              eof-value))  
      eof)))  
   
629  #|  #|
630  This version waits using server.  I changed to the non-server version because  This version waits using server.  I changed to the non-server version because
631  it allows this method to be used by CLX w/o confusing serve-event.  The  it allows this method to be used by CLX w/o confusing serve-event.  The
# Line 933  non-server method is also significantly Line 888  non-server method is also significantly
888  ;;;  ;;;
889  (defun fd-stream-misc-routine (stream operation &optional arg1 arg2)  (defun fd-stream-misc-routine (stream operation &optional arg1 arg2)
890    (case operation    (case operation
     (:read-line  
      (fd-stream-read-line stream arg1 arg2))  
891      (:listen      (:listen
892       (or (not (eql (fd-stream-ibuf-head stream)       (or (not (eql (fd-stream-ibuf-head stream)
893                     (fd-stream-ibuf-tail stream)))                     (fd-stream-ibuf-tail stream)))

Legend:
Removed from v.1.23.1.1  
changed lines
  Added in v.1.23.1.2

  ViewVC Help
Powered by ViewVC 1.1.5