Update of /project/climacs/cvsroot/climacs
In directory common-lisp:/tmp/cvs-serv26169
Modified Files:
file-commands.lisp
Log Message:
Added defaults to find-file commands, thanks to
Troels "Athas" Henriksen. Needs a recent mcclim.
Date: Sat Jan 21 14:38:50 2006
Author: dmurray
Index: climacs/file-commands.lisp
diff -u climacs/file-commands.lisp:1.1 climacs/file-commands.lisp:1.2
--- climacs/file-commands.lisp:1.1 Sat Nov 12 03:38:32 2005
+++ climacs/file-commands.lisp Sat Jan 21 14:38:50 2006
@@ -169,8 +169,21 @@
(redisplay-frame-panes *application-frame*)
buffer))))))
+(defun directory-of-buffer (buffer)
+ "Extract the directory part of the filepath to the file in BUFFER.
+ If BUFFER does not have a filepath, the path to the users home
+ directory will be returned."
+ (make-pathname
+ :directory
+ (pathname-directory
+ (or (filepath buffer)
+ (user-homedir-pathname)))))
+
(define-command (com-find-file :name t :command-table buffer-table) ()
- (let* ((filepath (accept 'pathname :prompt "Find File")))
+ (let* ((filepath (accept 'pathname :prompt "Find File"
+ :default (directory-of-buffer (buffer (current-window)))
+ :default-type 'pathname
+ :insert-default t)))
(find-file filepath)))
(set-key 'com-find-file
@@ -214,7 +227,10 @@
nil)))))))
(define-command (com-find-file-read-only :name t :command-table buffer-table) ()
- (let ((filepath (accept 'pathname :Prompt "Find file read only")))
+ (let ((filepath (accept 'pathname :Prompt "Find file read only"
+ :default (directory-of-buffer (buffer (current-window)))
+ :default-type 'pathname
+ :insert-default t)))
(find-file-read-only filepath)))
(set-key 'com-find-file-read-only
@@ -235,11 +251,17 @@
(needs-saving buffer) t))
(define-command (com-set-visited-file-name :name t :command-table buffer-table) ()
- (let ((filename (accept 'pathname :prompt "New file name")))
+ (let ((filename (accept 'pathname :prompt "New file name"
+ :default (directory-of-buffer (buffer (current-window)))
+ :default-type 'pathname
+ :insert-default t)))
(set-visited-file-name filename (buffer (current-window)))))
(define-command (com-insert-file :name t :command-table buffer-table) ()
- (let ((filename (accept 'pathname :prompt "Insert File"))
+ (let ((filename (accept 'pathname :prompt "Insert File"
+ :default (directory-of-buffer (buffer (current-window)))
+ :default-type 'pathname
+ :insert-default t))
(pane (current-window)))
(when (probe-file filename)
(setf (mark pane) (clone-mark (point pane) :left))
@@ -325,7 +347,10 @@
(call-next-method)))
(define-command (com-write-buffer :name t :command-table buffer-table) ()
- (let ((filepath (accept 'pathname :prompt "Write Buffer to File"))
+ (let ((filepath (accept 'pathname :prompt "Write Buffer to File"
+ :default (directory-of-buffer (buffer (current-window)))
+ :default-type 'pathname
+ :insert-default t))
(buffer (buffer (current-window))))
(cond
((directory-pathname-p filepath)