[climacs-cvs] CVS update: climacs/gui.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv20099

Modified Files:
	gui.lisp 
Log Message:
Implemented a suggestion from Lawrence Mitchell to avoid saving
a buffer that has not need to be saved. 


Date: Wed Dec 29 08:26:02 2004
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.29 climacs/gui.lisp:1.30
--- climacs/gui.lisp:1.29	Wed Dec 29 08:06:46 2004
+++ climacs/gui.lisp	Wed Dec 29 08:26:02 2004
@@ -88,6 +88,9 @@
   (let ((frame (make-application-frame 'climacs)))
     (run-frame-top-level frame)))
 
+(defun display-message (format-string &rest format-args)
+  (apply #'format *standard-input* format-string format-args))
+
 (defun display-info (frame pane)
   (let* ((win (win frame))
 	 (buf (buffer win))
@@ -305,15 +308,19 @@
        (beginning-of-buffer point))))
 
 (define-command com-save-buffer ()
-  (let ((filename (or (filename (buffer (win *application-frame*)))
-		      (accept 'completable-pathname
-			      :prompt "Save Buffer to File")))
-	(buffer (buffer (win *application-frame*))))
-    (with-open-file (stream filename :direction :output :if-exists :supersede)
-      (output-to-stream stream buffer 0 (size buffer)))
-    (setf (filename buffer) filename
-	  (name buffer) (pathname-filename filename)
-	  (needs-saving buffer) nil)))
+  (let* ((buffer (buffer (win *application-frame*)))
+	 (filename (or (filename buffer)
+		       (accept 'completable-pathname
+			       :prompt "Save Buffer to File"))))
+    (if (or (null (filename buffer))
+	    (needs-saving buffer))
+	(progn (with-open-file (stream filename :direction :output :if-exists :supersede)
+		 (output-to-stream stream buffer 0 (size buffer)))
+	       (setf (filename buffer) filename
+		     (name buffer) (pathname-filename filename))
+	       (display-message "Wrote: ~a" (filename buffer)))
+	(display-message "No changes need to be saved from ~a" (name buffer)))
+    (setf (needs-saving buffer) nil)))
 
 (define-command com-write-buffer ()
   (let ((filename (accept 'completable-pathname
@@ -323,7 +330,8 @@
       (output-to-stream stream buffer 0 (size buffer)))
     (setf (filename buffer) filename
 	  (name buffer) (pathname-filename filename)
-	  (needs-saving buffer) nil)))
+	  (needs-saving buffer) nil)
+    (display-message "Wrote: ~a" (filename buffer))))
 
 (define-command com-beginning-of-buffer ()
   (beginning-of-buffer (point (win *application-frame*))))