Commit 299ad9b5 authored by Troels Henriksen's avatar Troels Henriksen

Error handling now done by commands, handle errors when exiting in a

better way.
parent 162612e4
......@@ -323,37 +323,34 @@ file if necessary."
(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 @@ to overwrite."
(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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment