[climacs-cvs] CVS climacs

[dmurray]

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

Modified Files:
	file-commands.lisp 
Log Message:
Changed file commands to take arguments, taking advantage
of CSR's esa command-handling changes.


--- /project/climacs/cvsroot/climacs/file-commands.lisp	2006/05/07 20:11:20	1.15
+++ /project/climacs/cvsroot/climacs/file-commands.lisp	2006/05/10 20:33:45	1.16
@@ -288,29 +288,30 @@
     (or (filepath buffer)
 	(user-homedir-pathname)))))
 
-(define-command (com-find-file :name t :command-table buffer-table) ()
+(define-command (com-find-file :name t :command-table buffer-table)
+    ((filepath 'pathname
+	       :prompt "Find File"
+	       :default (directory-of-buffer (buffer (current-window)))
+	       :default-type 'pathname
+	       :insert-default t))
   "Prompt for a filename then edit that file.
 If a buffer is already visiting that file, switch to that buffer. Does not create a file if the filename given does not name an existing file."
-  (let* ((filepath (accept 'pathname :prompt "Find File"
-			   :default (directory-of-buffer (buffer (current-window)))
-			   :default-type 'pathname
-			   :insert-default t)))
-    (find-file filepath)))
+  (find-file filepath))
 
-(set-key 'com-find-file
+(set-key `(com-find-file ,*unsupplied-argument-marker*)
 	 'buffer-table
 	 '((#\x :control) (#\f :control)))
 
-(define-command (com-find-file-read-only :name t :command-table buffer-table) ()
+(define-command (com-find-file-read-only :name t :command-table buffer-table)
+    ((filepath 'pathname :Prompt "Find file read only"
+	       :default (directory-of-buffer (buffer (current-window)))
+	       :default-type 'pathname
+	       :insert-default t))
   "Prompt for a filename then open that file readonly.
 If a buffer is already visiting that file, switch to that buffer. If the filename given does not name an existing file, signal an error."
-  (let ((filepath (accept 'pathname :Prompt "Find file read only"
-			  :default (directory-of-buffer (buffer (current-window)))
-			  :default-type 'pathname
-			  :insert-default t)))
-    (find-file filepath t)))
+  (find-file filepath t))
 
-(set-key 'com-find-file-read-only
+(set-key `(com-find-file-read-only ,*unsupplied-argument-marker*)
 	 'buffer-table
 	 '((#\x :control) (#\r :control)))
 
@@ -331,23 +332,23 @@
 	(name buffer) (filepath-filename filename)
 	(needs-saving buffer) t))
 
-(define-command (com-set-visited-file-name :name t :command-table buffer-table) ()
+(define-command (com-set-visited-file-name :name t :command-table buffer-table)
+    ((filename 'pathname :prompt "New file name"
+	       :default (directory-of-buffer (buffer (current-window)))
+	       :default-type 'pathname
+	       :insert-default t))
   "Prompt for a new filename for the current buffer.
 The next time the buffer is saved it will be saved to a file with that filename."
-  (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)))))
+  (set-visited-file-name filename (buffer (current-window))))
 
-(define-command (com-insert-file :name t :command-table buffer-table) ()
+(define-command (com-insert-file :name t :command-table buffer-table)
+    ((filename 'pathname :prompt "Insert File"
+	       :default (directory-of-buffer (buffer (current-window)))
+	       :default-type 'pathname
+	       :insert-default t))
   "Prompt for a filename and insert its contents at point.
 Leaves mark after the inserted contents."
-  (let ((filename (accept 'pathname :prompt "Insert File"
-			  :default (directory-of-buffer (buffer (current-window)))
-			  :default-type 'pathname
-			  :insert-default t))
-	(pane (current-window)))
+  (let ((pane (current-window)))
     (when (probe-file filename)
       (setf (mark pane) (clone-mark (point pane) :left))
       (with-open-file (stream filename :direction :input)
@@ -358,7 +359,7 @@
 	     (offset (point pane)) (offset (mark pane))))
     (redisplay-frame-panes *application-frame*)))
 
-(set-key 'com-insert-file
+(set-key `(com-insert-file ,*unsupplied-argument-marker*)
 	 'buffer-table
 	 '((#\x :control) (#\i :control)))
 
@@ -477,14 +478,14 @@
 			       (return-from frame-exit nil)))))
     (call-next-method)))
 
-(define-command (com-write-buffer :name t :command-table buffer-table) ()
+(define-command (com-write-buffer :name t :command-table buffer-table)
+    ((filepath 'pathname :prompt "Write Buffer to File"
+	       :default (directory-of-buffer (buffer (current-window)))
+	       :default-type 'pathname
+	       :insert-default t))
   "Prompt for a filename and write the current buffer to it.
 Changes the file visted by the buffer to the given 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))))
+  (let ((buffer (buffer (current-window))))
     (cond
       ((directory-pathname-p filepath)
        (display-message "~A is a directory name." filepath))
@@ -496,7 +497,7 @@
 	     (needs-saving buffer) nil)
        (display-message "Wrote: ~a" (filepath buffer))))))
 
-(set-key 'com-write-buffer
+(set-key `(com-write-buffer ,*unsupplied-argument-marker*)
 	 'buffer-table
 	 '((#\x :control) (#\w :control)))