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

Diff of /climacs/gui.lisp

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

revision 1.133 by crhodes, Fri May 6 16:56:32 2005 UTC revision 1.134 by abakic, Fri May 6 22:32:28 2005 UTC
# Line 693  Line 693 
693      (declare (ignore success))      (declare (ignore success))
694      (or pathname string)))      (or pathname string)))
695    
696  (defun pathname-filename (pathname)  (defun filepath-filename (pathname)
697    (if (null (pathname-type pathname))    (if (null (pathname-type pathname))
698        (pathname-name pathname)        (pathname-name pathname)
699        (concatenate 'string (pathname-name pathname)        (concatenate 'string (pathname-name pathname)
700                     "." (pathname-type pathname))))                     "." (pathname-type pathname))))
701    
702  (define-named-command com-find-file ()  (define-named-command com-find-file ()
703    (let ((filename (accept 'completable-pathname    (let ((filepath (accept 'completable-pathname
704                            :prompt "Find File"))                            :prompt "Find File"))
705          (buffer (make-instance 'climacs-buffer))          (buffer (make-instance 'climacs-buffer))
706          (pane (current-window)))          (pane (current-window)))
# Line 709  Line 709 
709      (setf (syntax buffer) (make-instance      (setf (syntax buffer) (make-instance
710                             'basic-syntax :buffer (buffer (point pane))))                             'basic-syntax :buffer (buffer (point pane))))
711      ;; Don't want to create the file if it doesn't exist.      ;; Don't want to create the file if it doesn't exist.
712      (when (probe-file filename)      (when (probe-file filepath)
713        (with-open-file (stream filename :direction :input)        (with-open-file (stream filepath :direction :input)
714          (input-from-stream stream buffer 0)))          (input-from-stream stream buffer 0)))
715      (setf (filename buffer) filename      (setf (filepath buffer) filepath
716            (name buffer) (pathname-filename filename)            (name buffer) (filepath-filename filepath)
717            (needs-saving buffer) nil)            (needs-saving buffer) nil)
718      (beginning-of-buffer (point pane))      (beginning-of-buffer (point pane))
719      ;; this one is needed so that the buffer modification protocol      ;; this one is needed so that the buffer modification protocol
# Line 721  Line 721 
721      (redisplay-frame-panes *application-frame*)))      (redisplay-frame-panes *application-frame*)))
722    
723  (defun save-buffer (buffer)  (defun save-buffer (buffer)
724    (let ((filename (or (filename buffer)    (let ((filepath (or (filepath buffer)
725                        (accept 'completable-pathname                        (accept 'completable-pathname
726                                :prompt "Save Buffer to File"))))                                :prompt "Save Buffer to File"))))
727      (with-open-file (stream filename :direction :output :if-exists :supersede)      (with-open-file (stream filepath :direction :output :if-exists :supersede)
728        (output-to-stream stream buffer 0 (size buffer)))        (output-to-stream stream buffer 0 (size buffer)))
729      (setf (filename buffer) filename      (setf (filepath buffer) filepath
730            (name buffer) (pathname-filename filename))            (name buffer) (filepath-filename filepath))
731      (display-message "Wrote: ~a" (filename buffer))      (display-message "Wrote: ~a" (filepath buffer))
732      (setf (needs-saving buffer) nil)))      (setf (needs-saving buffer) nil)))
733    
734  (define-named-command com-save-buffer ()  (define-named-command com-save-buffer ()
735    (let ((buffer (buffer (current-window))))    (let ((buffer (buffer (current-window))))
736      (if (or (null (filename buffer))      (if (or (null (filepath buffer))
737              (needs-saving buffer))              (needs-saving buffer))
738          (save-buffer buffer)          (save-buffer buffer)
739          (display-message "No changes need to be saved from ~a" (name buffer)))))          (display-message "No changes need to be saved from ~a" (name buffer)))))
# Line 756  Line 756 
756      (frame-exit *application-frame*)))      (frame-exit *application-frame*)))
757    
758  (define-named-command com-write-buffer ()  (define-named-command com-write-buffer ()
759    (let ((filename (accept 'completable-pathname    (let ((filepath (accept 'completable-pathname
760                            :prompt "Write Buffer to File"))                            :prompt "Write Buffer to File"))
761          (buffer (buffer (current-window))))          (buffer (buffer (current-window))))
762      (with-open-file (stream filename :direction :output :if-exists :supersede)      (with-open-file (stream filepath :direction :output :if-exists :supersede)
763        (output-to-stream stream buffer 0 (size buffer)))        (output-to-stream stream buffer 0 (size buffer)))
764      (setf (filename buffer) filename      (setf (filepath buffer) filepath
765            (name buffer) (pathname-filename filename)            (name buffer) (filepath-filename filepath)
766            (needs-saving buffer) nil)            (needs-saving buffer) nil)
767      (display-message "Wrote: ~a" (filename buffer))))      (display-message "Wrote: ~a" (filepath buffer))))
768    
769  (define-presentation-method accept  (define-presentation-method accept
770      ((type buffer) stream (view textual-view) &key)      ((type buffer) stream (view textual-view) &key)
# Line 809  Line 809 
809    (full-redisplay (current-window)))    (full-redisplay (current-window)))
810    
811  (define-named-command com-load-file ()  (define-named-command com-load-file ()
812    (let ((filename (accept 'completable-pathname    (let ((filepath (accept 'completable-pathname
813                            :prompt "Load File")))                            :prompt "Load File")))
814      (load filename)))      (load filepath)))
815    
816  (define-named-command com-beginning-of-buffer ()  (define-named-command com-beginning-of-buffer ()
817    (beginning-of-buffer (point (current-window))))    (beginning-of-buffer (point (current-window))))

Legend:
Removed from v.1.133  
changed lines
  Added in v.1.134

  ViewVC Help
Powered by ViewVC 1.1.5