[climacs-cvs] CVS esa

[thenriksen]

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

Modified Files:
	packages.lisp esa-io.lisp 
Log Message:
`current-buffer' should not take required arguments, but we still need
to be able to do per-application method dispatch. So introduce
`frame-current-buffer'.


--- /project/climacs/cvsroot/esa/packages.lisp	2006/08/20 10:08:23	1.6
+++ /project/climacs/cvsroot/esa/packages.lisp	2006/09/03 21:22:05	1.7
@@ -25,7 +25,7 @@
 
 (defpackage :esa-io
   (:use :clim-lisp :clim :esa :esa-buffer)
-  (:export #:buffers #:current-buffer
+  (:export #:buffers #:frame-current-buffer #:current-buffer
            #:find-file #:find-file-read-only
            #:set-visited-filename
            #:save-buffer #:write-buffer
--- /project/climacs/cvsroot/esa/esa-io.lisp	2006/08/20 10:43:40	1.4
+++ /project/climacs/cvsroot/esa/esa-io.lisp	2006/09/03 21:22:05	1.5
@@ -23,9 +23,14 @@
 (defgeneric buffers (application-frame)
   (:documentation "Return a list of all the buffers of the application"))
 
-(defgeneric current-buffer (application-frame)
+(defgeneric frame-current-buffer (application-frame)
   (:documentation "Return the current buffer of APPLICATION-FRAME"))
 
+(defun current-buffer (&optional (frame *application-frame*))
+  "Return the current buffer of `frame'. This function merely
+calls `frame-current-buffer' with `frame' as argument."
+  (frame-current-buffer frame))
+
 (defgeneric find-file (file-path application-frame))
 (defgeneric find-file-read-only (file-path application-frame))
 (defgeneric set-visited-filename (filepath buffer application-frame))
@@ -164,7 +169,7 @@
   (make-pathname
    :directory
    (pathname-directory
-    (or (filepath (current-buffer *application-frame*))
+    (or (filepath (current-buffer))
         (user-homedir-pathname)))))
 
 (define-command (com-find-file :name t :command-table esa-io-table) 
@@ -226,7 +231,7 @@
   "Toggle the readonly status of the current buffer.
 When a buffer is readonly, attempts to change the contents of the
 buffer signal an error."
-  (let ((buffer (current-buffer *application-frame*)))
+  (let ((buffer (current-buffer)))
     (setf (read-only-p buffer) (not (read-only-p buffer)))))
 
 (set-key 'com-read-only 'esa-io-table '((#\x :control) (#\q :control)))
@@ -246,7 +251,7 @@
     "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."
-  (set-visited-file-name filename (current-buffer *application-frame*) *application-frame*))
+  (set-visited-file-name filename (current-buffer) *application-frame*))
 
 (defun extract-version-number (pathname)
   "Extracts the emacs-style version-number from a pathname."
@@ -312,7 +317,7 @@
     "Write the contents of the buffer to a file.
 If there is filename associated with the buffer, write to that
 file, replacing its contents. If not, prompt for a filename."
-  (let ((buffer (current-buffer *application-frame*)))
+  (let ((buffer (current-buffer)))
     (if (or (null (filepath buffer))
             (needs-saving buffer))
         (save-buffer buffer *application-frame*)
@@ -338,7 +343,7 @@
                :default-type 'pathname))
     "Prompt for a filename and write the current buffer to it.
 Changes the file visted by the buffer to the given file."
-  (let ((buffer (current-buffer *application-frame*)))
+  (let ((buffer (current-buffer)))
     (write-buffer buffer filepath *application-frame*)))
 
 (set-key `(com-write-buffer ,*unsupplied-argument-marker*)