[mcclim-cvs] CVS mcclim/ESA

thenriksen thenriksen at common-lisp.net
Sun May 18 09:20:22 UTC 2008


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

Modified Files:
	esa-io.lisp 
Log Message:
Move error ESA-IO handling into commands.


--- /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp	2008/05/18 09:09:22	1.10
+++ /project/mcclim/cvsroot/mcclim/ESA/esa-io.lisp	2008/05/18 09:20:21	1.11
@@ -136,7 +136,9 @@
 If a buffer is already visiting that file, switch to that
 buffer. Does not create a file if the filename given does not
 name an existing file."
-  (find-file filepath))
+  (handler-case (find-file filepath)
+    (file-error (e)
+      (display-message "~A" e))))
 
 (set-key `(com-find-file ,*unsupplied-argument-marker*)
          'esa-io-table '((#\x :control) (#\f :control)))
@@ -248,28 +250,25 @@
 	t)))
 
 (defmethod frame-save-buffer (application-frame buffer)
-  (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))))
+  (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)))
 
 (define-command (com-save-buffer :name t :command-table esa-io-table) ()
   "Write the contents of the buffer to a file.
@@ -283,10 +282,8 @@
                                             :default-type 'pathname))
         (if (needs-saving buffer)
             (handler-case (save-buffer buffer)
-              (buffer-writing-error (e)
-                (with-minibuffer-stream (minibuffer)
-                  (let ((*print-escape* nil))
-                    (print-object e minibuffer)))))
+              ((or buffer-writing-error file-error) (e)
+                (display-message "~A" e)))
             (display-message "No changes need to be saved from ~a" (name buffer))))))
 
 (set-key 'com-save-buffer 'esa-io-table '((#\x :control) (#\s :control)))




More information about the Mcclim-cvs mailing list