/[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.83 by rtoy, Mon Apr 4 14:33:17 2005 UTC revision 1.84 by rtoy, Mon Feb 27 16:06:34 2006 UTC
# Line 1098  Line 1098 
1098    
1099  ;;; REVERT-FILE -- internal  ;;; REVERT-FILE -- internal
1100  ;;;  ;;;
1101  ;;;   Revert a file, if possible; otherwise just delete it.  Used during  ;;;   Revert a file, if possible; otherwise do nothing.  Used during
1102  ;;; CLOSE when the abort flag is set.  ;;; CLOSE when the abort flag is set.
1103  ;;;  ;;;
1104  (defun revert-file (filename original)  (defun revert-file (filename original)
1105    (declare (type simple-base-string filename)    (declare (type simple-base-string filename)
1106             (type (or simple-base-string null) original))             (type (or simple-base-string null) original))
1107    (if original    (when original
1108        (multiple-value-bind (okay err) (unix:unix-rename original filename)      (multiple-value-bind (okay err)
1109          (unless okay          (unix:unix-rename original filename)
1110          (unless okay
1111            (cerror "Go on as if nothing bad happened."            (cerror "Go on as if nothing bad happened."
1112                    "Could not restore ~S to its original contents: ~A"                    "Could not restore ~S to its original contents: ~A"
                   filename (unix:get-unix-error-msg err))))  
       (multiple-value-bind (okay err) (unix:unix-unlink filename)  
         (unless okay  
           (cerror "Go on as if nothing bad happened."  
                   "Could not remove ~S: ~A"  
1113                    filename (unix:get-unix-error-msg err))))))                    filename (unix:get-unix-error-msg err))))))
1114    
1115  ;;; DELETE-ORIGINAL -- internal  ;;; DELETE-ORIGINAL -- internal

Legend:
Removed from v.1.83  
changed lines
  Added in v.1.84

  ViewVC Help
Powered by ViewVC 1.1.5