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

Robert Strandh rstrandh at common-lisp.net
Tue Dec 28 17:32:23 UTC 2004


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

Modified Files:
	gui.lisp 
Log Message:
Better buffer name. 

Save-buffer now sets the filename and the name of the buffer. 


Date: Tue Dec 28 18:32:20 2004
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.22 climacs/gui.lisp:1.23
--- climacs/gui.lisp:1.22	Tue Dec 28 17:57:26 2004
+++ climacs/gui.lisp	Tue Dec 28 18:32:18 2004
@@ -280,6 +280,12 @@
     (declare (ignore success))
     (or pathname string)))
 
+(defun pathname-filename (pathname)
+  (if (null (pathname-type pathname))
+      (pathname-name pathname)
+      (concatenate 'string (pathname-name pathname)
+		   "." (pathname-type pathname))))
+
 (define-command com-find-file ()
   (let ((filename (accept 'completable-pathname
 			  :prompt "Find File")))
@@ -290,7 +296,7 @@
        (with-open-file (stream filename :direction :input :if-does-not-exist :create)
 	 (input-from-stream stream buffer 0))
        (setf (filename buffer) filename
-	     (name buffer) (pathname-name filename))
+	     (name buffer) (pathname-filename filename))
        (beginning-of-buffer point))))
 
 (define-command com-save-buffer ()
@@ -300,6 +306,8 @@
 	(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))
     (setf (modified-p (buffer (win *application-frame*))) nil)))
 
 (define-command com-write-buffer ()
@@ -309,7 +317,7 @@
     (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-name filename))
+	  (name buffer) (pathname-filename filename))
     (setf (modified-p (buffer (win *application-frame*))) nil)))
 
 (define-command com-beginning-of-buffer ()




More information about the Climacs-cvs mailing list