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)