[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