[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv22105

Modified Files:
	core.lisp 
Log Message:
Error handling now done by commands, handle errors when exiting in a
better way.


--- /project/climacs/cvsroot/climacs/core.lisp	2008/05/18 09:05:11	1.26
+++ /project/climacs/cvsroot/climacs/core.lisp	2008/05/18 09:20:42	1.27
@@ -323,37 +323,34 @@
 	 (display-message "~A is a directory name." filepath)
 	 (beep))
         (t
-         (handler-case
-             (let ((existing-view (find-view-with-pathname filepath)))
-               (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t))
-                   (switch-to-view (current-window) existing-view)
-                   (let* ((newp (not (probe-file filepath)))
-                          (buffer (if (and newp (not readonlyp))
-                                      (make-new-buffer)
-                                      (with-open-file (stream filepath :direction :input)
-                                        (make-buffer-from-stream stream))))
-                          (view (make-new-view-for-climacs
-                                 *esa-instance* 'textual-drei-syntax-view
-                                 :name (filepath-filename filepath)
-                                 :buffer buffer)))
-                     (unless (buffer-pane-p (current-window))
-                       (other-window (or (find-if #'(lambda (window)
-                                                      (typep window 'climacs-pane))
-                                                  (windows *esa-instance*))
-                                         (split-window t))))
-                     (setf (offset (point buffer)) (offset (point view))
-                           (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath))
-                           (file-write-time buffer) (if newp (get-universal-time) (file-write-date filepath))
-                           (needs-saving buffer) nil
-                           (name buffer) (filepath-filename filepath))
-                     (setf (current-view (current-window)) view)
-                     (evaluate-attribute-line view)
-                     (setf (filepath buffer) (pathname filepath)
-                           (read-only-p buffer) readonlyp)
-                     (beginning-of-buffer (point view))
-                     buffer)))
-           (file-error (c)
-             (display-message "~A" c))))))
+         (let ((existing-view (find-view-with-pathname filepath)))
+           (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t))
+               (switch-to-view (current-window) existing-view)
+               (let* ((newp (not (probe-file filepath)))
+                      (buffer (if (and newp (not readonlyp))
+                                  (make-new-buffer)
+                                  (with-open-file (stream filepath :direction :input)
+                                    (make-buffer-from-stream stream))))
+                      (view (make-new-view-for-climacs
+                             *esa-instance* 'textual-drei-syntax-view
+                             :name (filepath-filename filepath)
+                             :buffer buffer)))
+                 (unless (buffer-pane-p (current-window))
+                   (other-window (or (find-if #'(lambda (window)
+                                                  (typep window 'climacs-pane))
+                                              (windows *esa-instance*))
+                                     (split-window t))))
+                 (setf (offset (point buffer)) (offset (point view))
+                       (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath))
+                       (file-write-time buffer) (if newp (get-universal-time) (file-write-date filepath))
+                       (needs-saving buffer) nil
+                       (name buffer) (filepath-filename filepath))
+                 (setf (current-view (current-window)) view)
+                 (evaluate-attribute-line view)
+                 (setf (filepath buffer) (pathname filepath)
+                       (read-only-p buffer) readonlyp)
+                 (beginning-of-buffer (point view))
+                 buffer))))))
 
 (defmethod frame-find-file ((application-frame climacs) filepath)
   (find-file-impl filepath nil))
@@ -394,13 +391,17 @@
 
 (defmethod frame-exit :around ((frame climacs) #-mcclim &key)
   (dolist (view (views frame))
-    (when (and (buffer-of-view-needs-saving view)
-               (handler-case (accept 'boolean
-                              :prompt (format nil "Save buffer of view: ~a ?" (name view)))
-                 (error () (progn (beep)
-                                  (display-message "Invalid answer")
-                                  (return-from frame-exit nil)))))
-      (save-buffer (buffer view))))
+    (handler-case
+        (when (and (buffer-of-view-needs-saving view)
+                   (handler-case (accept 'boolean
+                                  :prompt (format nil "Save buffer of view: ~a ?" (name view)))
+                     (error () (progn (beep)
+                                      (display-message "Invalid answer")
+                                      (return-from frame-exit nil)))))
+          (save-buffer (buffer view)))
+      (file-error (e)
+        (display-message "~A (hit a key to continue)" e)
+        (read-gesture))))
   (when (or (notany #'buffer-of-view-needs-saving (views frame))
 	    (handler-case (accept 'boolean :prompt "Modified buffers of views exist.  Quit anyway?")
 	      (error () (progn (beep)