[climacs-cvs] CVS esa

[crhodes]

Update of /project/climacs/cvsroot/esa
In directory clnet:/tmp/cvs-serv31345

Modified Files:
	esa-io.lisp 
Log Message:
Modify the IO commands to take advantage of the new command parser.  
Also add an editable default where that seems appropriate.

(Possibly this calls for a 'pathname-with-buffer-default presentation 
type, to save typing the same thing many times...)


--- /project/climacs/cvsroot/esa/esa-io.lisp	2006/03/25 00:08:07	1.1.1.1
+++ /project/climacs/cvsroot/esa/esa-io.lisp	2006/05/10 09:53:55	1.2
@@ -157,11 +157,21 @@
                      (needs-saving buffer) nil)
                buffer)))))
 
-(define-command (com-find-file :name t :command-table esa-io-table) ()
-  (let* ((filepath (accept 'pathname :prompt "Find File")))
-    (find-file filepath *application-frame*)))
+(defun directory-of-current-buffer ()
+  (make-pathname
+   :directory
+   (pathname-directory
+    (or (filepath (current-buffer *application-frame*))
+        (user-homedir-pathname)))))
+
+(define-command (com-find-file :name t :command-table esa-io-table) 
+    ((filepath 'pathname :prompt "Find File: " :prompt-mode :raw
+               :default (directory-of-current-buffer) :default-type 'pathname
+               :insert-default t))
+  (find-file filepath *application-frame*))
 
-(set-key 'com-find-file 'esa-io-table '((#\x :control) (#\f :control)))
+(set-key `(com-find-file ,*unsupplied-argument-marker*)
+         'esa-io-table '((#\x :control) (#\f :control)))
 
 (defmethod find-file-read-only (filepath application-frame)
   (cond ((null filepath)
@@ -185,11 +195,12 @@
                    (beep)
                    nil))))))
 
-(define-command (com-find-file-read-only :name t :command-table esa-io-table) ()
-  (let ((filepath (accept 'pathname :Prompt "Find file read only")))
-    (find-file-read-only filepath *application-frame*)))
+(define-command (com-find-file-read-only :name t :command-table esa-io-table)
+    ((filepath 'pathname :prompt "Find File read-only: " :prompt-mode :raw))
+  (find-file-read-only filepath *application-frame*))
 
-(set-key 'com-find-file-read-only 'esa-io-table '((#\x :control) (#\r :control)))
+(set-key `(com-find-file-read-only ,*unsupplied-argument-marker*)
+         'esa-io-table '((#\x :control) (#\r :control)))
 
 (define-command (com-read-only :name t :command-table esa-io-table) ()
   (let ((buffer (current-buffer *application-frame*)))
@@ -202,9 +213,11 @@
         (name buffer) (filepath-filename filename)
         (needs-saving buffer) t))
 
-(define-command (com-set-visited-file-name :name t :command-table esa-io-table) ()
-  (let ((filename (accept 'pathname :prompt "New file name")))
-    (set-visited-file-name filename (current-buffer *application-frame*) *application-frame*)))
+(define-command (com-set-visited-file-name :name t :command-table esa-io-table)
+    ((filename 'pathname :prompt "New file name: " :prompt-mode :raw
+               :default (directory-of-current-buffer) :insert-default t
+               :default-type 'pathname))
+  (set-visited-file-name filename (current-buffer *application-frame*) *application-frame*))
 
 (defmethod save-buffer (buffer application-frame)
   (let ((filepath (or (filepath buffer)
@@ -247,10 +260,13 @@
            (needs-saving buffer) nil)
      (display-message "Wrote: ~a" (filepath buffer)))))
 
-(define-command (com-write-buffer :name t :command-table esa-io-table) ()
-  (let ((filepath (accept 'pathname :prompt "Write Buffer to File"))
-        (buffer (current-buffer *application-frame*)))
+(define-command (com-write-buffer :name t :command-table esa-io-table) 
+    ((filepath 'pathname :prompt "Write Buffer to File: " :prompt-mode :raw
+               :default (directory-of-current-buffer) :insert-default t
+               :default-type 'pathname))
+  (let ((buffer (current-buffer *application-frame*)))
     (write-buffer buffer filepath *application-frame*)))
 
-(set-key 'com-write-buffer 'esa-io-table '((#\x :control) (#\w :control)))
+(set-key `(com-write-buffer ,*unsupplied-argument-marker*)
+         'esa-io-table '((#\x :control) (#\w :control)))