/[climacs]/climacs/core.lisp
ViewVC logotype

Diff of /climacs/core.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by thenriksen, Sun May 18 09:05:11 2008 UTC revision 1.27 by thenriksen, Sun May 18 09:20:42 2008 UTC
# Line 323  file if necessary." Line 323  file if necessary."
323           (display-message "~A is a directory name." filepath)           (display-message "~A is a directory name." filepath)
324           (beep))           (beep))
325          (t          (t
326           (handler-case           (let ((existing-view (find-view-with-pathname filepath)))
327               (let ((existing-view (find-view-with-pathname filepath)))             (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t))
328                 (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t))                 (switch-to-view (current-window) existing-view)
329                     (switch-to-view (current-window) existing-view)                 (let* ((newp (not (probe-file filepath)))
330                     (let* ((newp (not (probe-file filepath)))                        (buffer (if (and newp (not readonlyp))
331                            (buffer (if (and newp (not readonlyp))                                    (make-new-buffer)
332                                        (make-new-buffer)                                    (with-open-file (stream filepath :direction :input)
333                                        (with-open-file (stream filepath :direction :input)                                      (make-buffer-from-stream stream))))
334                                          (make-buffer-from-stream stream))))                        (view (make-new-view-for-climacs
335                            (view (make-new-view-for-climacs                               *esa-instance* 'textual-drei-syntax-view
336                                   *esa-instance* 'textual-drei-syntax-view                               :name (filepath-filename filepath)
337                                   :name (filepath-filename filepath)                               :buffer buffer)))
338                                   :buffer buffer)))                   (unless (buffer-pane-p (current-window))
339                       (unless (buffer-pane-p (current-window))                     (other-window (or (find-if #'(lambda (window)
340                         (other-window (or (find-if #'(lambda (window)                                                    (typep window 'climacs-pane))
341                                                        (typep window 'climacs-pane))                                                (windows *esa-instance*))
342                                                    (windows *esa-instance*))                                       (split-window t))))
343                                           (split-window t))))                   (setf (offset (point buffer)) (offset (point view))
344                       (setf (offset (point buffer)) (offset (point view))                         (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath))
345                             (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))
346                             (file-write-time buffer) (if newp (get-universal-time) (file-write-date filepath))                         (needs-saving buffer) nil
347                             (needs-saving buffer) nil                         (name buffer) (filepath-filename filepath))
348                             (name buffer) (filepath-filename filepath))                   (setf (current-view (current-window)) view)
349                       (setf (current-view (current-window)) view)                   (evaluate-attribute-line view)
350                       (evaluate-attribute-line view)                   (setf (filepath buffer) (pathname filepath)
351                       (setf (filepath buffer) (pathname filepath)                         (read-only-p buffer) readonlyp)
352                             (read-only-p buffer) readonlyp)                   (beginning-of-buffer (point view))
353                       (beginning-of-buffer (point view))                   buffer))))))
                      buffer)))  
            (file-error (c)  
              (display-message "~A" c))))))  
354    
355  (defmethod frame-find-file ((application-frame climacs) filepath)  (defmethod frame-find-file ((application-frame climacs) filepath)
356    (find-file-impl filepath nil))    (find-file-impl filepath nil))
# Line 394  to overwrite." Line 391  to overwrite."
391    
392  (defmethod frame-exit :around ((frame climacs) #-mcclim &key)  (defmethod frame-exit :around ((frame climacs) #-mcclim &key)
393    (dolist (view (views frame))    (dolist (view (views frame))
394      (when (and (buffer-of-view-needs-saving view)      (handler-case
395                 (handler-case (accept 'boolean          (when (and (buffer-of-view-needs-saving view)
396                                :prompt (format nil "Save buffer of view: ~a ?" (name view)))                     (handler-case (accept 'boolean
397                   (error () (progn (beep)                                    :prompt (format nil "Save buffer of view: ~a ?" (name view)))
398                                    (display-message "Invalid answer")                       (error () (progn (beep)
399                                    (return-from frame-exit nil)))))                                        (display-message "Invalid answer")
400        (save-buffer (buffer view))))                                        (return-from frame-exit nil)))))
401              (save-buffer (buffer view)))
402          (file-error (e)
403            (display-message "~A (hit a key to continue)" e)
404            (read-gesture))))
405    (when (or (notany #'buffer-of-view-needs-saving (views frame))    (when (or (notany #'buffer-of-view-needs-saving (views frame))
406              (handler-case (accept 'boolean :prompt "Modified buffers of views exist.  Quit anyway?")              (handler-case (accept 'boolean :prompt "Modified buffers of views exist.  Quit anyway?")
407                (error () (progn (beep)                (error () (progn (beep)

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

  ViewVC Help
Powered by ViewVC 1.1.5