Changeset 243

Show
Ignore:
Timestamp:
08/18/11 06:08:56 (21 months ago)
Author:
rjs
Message:

Version 31.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • trunk/lisp/lmio/qfile.lisp

    r242 r243  
    896896                    (FUNCALL STREAM-OR-ERROR-MESSAGE ':CLOSE)))))) ;In case this did something 
    897897 
    898 (DEFUN FILE-CLOSE (IGNORE &AUX PKT SUCCESS STRING FILENAME-ORIGIN) 
     898(DEFUN FILE-CLOSE (IGNORE &OPTIONAL ABORTP &AUX PKT SUCCESS STRING FILENAME-ORIGIN) 
    899899  (COND ((EQ (CHANNEL-STATE FILE-CHANNEL) ':CLOSED) NIL) 
    900900        ((NEQ (CHAOS:STATE (CHANNEL-CONTROL-CONNECTION FILE-CHANNEL)) 'CHAOS:OPEN-STATE) 
    901901         (SETF (CHANNEL-STATE FILE-CHANNEL) ':CLOSED) 
    902902         T) 
    903         (T (AND (EQ (CHANNEL-STATE FILE-CHANNEL) ':OPEN) 
    904                 (EQ (CHANNEL-DIRECTION FILE-CHANNEL) ':OUTPUT) 
    905                 (FUNCALL (CHANNEL-FUNCTION FILE-CHANNEL) ':EOF)) 
     903        (T (COND ((AND (EQ (CHANNEL-STATE FILE-CHANNEL) ':OPEN) 
     904                       (EQ (CHANNEL-DIRECTION FILE-CHANNEL) ':OUTPUT)) 
     905                  ;; Closing an open output channel.  Finish sending the data. 
     906                  (FUNCALL (CHANNEL-FUNCTION FILE-CHANNEL) ':EOF) 
     907                  ;; If aborting out of a file-writing operation before normal :CLOSE, 
     908                  ;; delete the incomplete file.  Don't worry if it gets an error. 
     909                  (AND (EQ ABORTP ':ABORT) 
     910                       (FUNCALL (CHANNEL-FUNCTION FILE-CHANNEL) ':COMMAND NIL "DELETE")))) 
    906911           (COND ((CHANNEL-DATA-PACKET FILE-CHANNEL) 
    907912                  (FUNCALL (CHANNEL-FUNCTION FILE-CHANNEL) ':RETURN