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

Diff of /climacs/gui.lisp

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

revision 1.29 by ejohnson, Wed Dec 29 07:06:46 2004 UTC revision 1.30 by rstrandh, Wed Dec 29 07:26:02 2004 UTC
# Line 88  Line 88 
88    (let ((frame (make-application-frame 'climacs)))    (let ((frame (make-application-frame 'climacs)))
89      (run-frame-top-level frame)))      (run-frame-top-level frame)))
90    
91    (defun display-message (format-string &rest format-args)
92      (apply #'format *standard-input* format-string format-args))
93    
94  (defun display-info (frame pane)  (defun display-info (frame pane)
95    (let* ((win (win frame))    (let* ((win (win frame))
96           (buf (buffer win))           (buf (buffer win))
# Line 305  Line 308 
308         (beginning-of-buffer point))))         (beginning-of-buffer point))))
309    
310  (define-command com-save-buffer ()  (define-command com-save-buffer ()
311    (let ((filename (or (filename (buffer (win *application-frame*)))    (let* ((buffer (buffer (win *application-frame*)))
312                        (accept 'completable-pathname           (filename (or (filename buffer)
313                                :prompt "Save Buffer to File")))                         (accept 'completable-pathname
314          (buffer (buffer (win *application-frame*))))                                 :prompt "Save Buffer to File"))))
315      (with-open-file (stream filename :direction :output :if-exists :supersede)      (if (or (null (filename buffer))
316        (output-to-stream stream buffer 0 (size buffer)))              (needs-saving buffer))
317      (setf (filename buffer) filename          (progn (with-open-file (stream filename :direction :output :if-exists :supersede)
318            (name buffer) (pathname-filename filename)                   (output-to-stream stream buffer 0 (size buffer)))
319            (needs-saving buffer) nil)))                 (setf (filename buffer) filename
320                         (name buffer) (pathname-filename filename))
321                   (display-message "Wrote: ~a" (filename buffer)))
322            (display-message "No changes need to be saved from ~a" (name buffer)))
323        (setf (needs-saving buffer) nil)))
324    
325  (define-command com-write-buffer ()  (define-command com-write-buffer ()
326    (let ((filename (accept 'completable-pathname    (let ((filename (accept 'completable-pathname
# Line 323  Line 330 
330        (output-to-stream stream buffer 0 (size buffer)))        (output-to-stream stream buffer 0 (size buffer)))
331      (setf (filename buffer) filename      (setf (filename buffer) filename
332            (name buffer) (pathname-filename filename)            (name buffer) (pathname-filename filename)
333            (needs-saving buffer) nil)))            (needs-saving buffer) nil)
334        (display-message "Wrote: ~a" (filename buffer))))
335    
336  (define-command com-beginning-of-buffer ()  (define-command com-beginning-of-buffer ()
337    (beginning-of-buffer (point (win *application-frame*))))    (beginning-of-buffer (point (win *application-frame*))))

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30

  ViewVC Help
Powered by ViewVC 1.1.5