Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv18592/ESA

Modified Files: esa-io.lisp Log Message: Handle file-errors when writing files in ESA.

--- /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp 2008/01/29 22:59:30 1.9 +++ /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp 2008/05/18 09:09:22 1.10 @@ -248,25 +248,28 @@ t)))

(defmethod frame-save-buffer (application-frame buffer) - (let ((filepath (or (filepath buffer) - (accept 'pathname :prompt "Save Buffer to File")))) - (check-buffer-writability application-frame filepath buffer) - (unless (check-file-times buffer filepath "Overwrite" "written") - (return-from frame-save-buffer)) - (when (and (probe-file filepath) (not (file-saved-p buffer))) - (let ((backup-name (pathname-name filepath)) - (backup-type (format nil "~A~~~D~~" - (pathname-type filepath) - (1+ (version-number filepath))))) - (rename-file filepath (make-pathname :name backup-name - :type backup-type)))) - (with-open-file (stream filepath :direction :output :if-exists :supersede) - (save-buffer-to-stream buffer stream)) - (setf (filepath buffer) filepath - (file-write-time buffer) (file-write-date filepath) - (name buffer) (filepath-filename filepath)) - (display-message "Wrote: ~a" (filepath buffer)) - (setf (needs-saving buffer) nil))) + (handler-case + (let ((filepath (or (filepath buffer) + (accept 'pathname :prompt "Save Buffer to File")))) + (check-buffer-writability application-frame filepath buffer) + (unless (check-file-times buffer filepath "Overwrite" "written") + (return-from frame-save-buffer)) + (when (and (probe-file filepath) (not (file-saved-p buffer))) + (let ((backup-name (pathname-name filepath)) + (backup-type (format nil "~A~~~D~~" + (pathname-type filepath) + (1+ (version-number filepath))))) + (rename-file filepath (make-pathname :name backup-name + :type backup-type)))) + (with-open-file (stream filepath :direction :output :if-exists :supersede) + (save-buffer-to-stream buffer stream)) + (setf (filepath buffer) filepath + (file-write-time buffer) (file-write-date filepath) + (name buffer) (filepath-filename filepath)) + (display-message "Wrote: ~a" (filepath buffer)) + (setf (needs-saving buffer) nil)) + (file-error (c) + (display-message "~A" c))))

(define-command (com-save-buffer :name t :command-table esa-io-table) () "Write the contents of the buffer to a file.