[climacs-cvs] CVS esa
thenriksen
thenriksen at common-lisp.net
Fri Sep 8 18:08:03 UTC 2006
Update of /project/climacs/cvsroot/esa
In directory clnet:/tmp/cvs-serv26054
Modified Files:
packages.lisp esa.asd esa-io.lisp esa-buffer.lisp
Log Message:
Changed some generic functions to be nongeneric trampolines calling
generic functions with *application-frame* as the argument. This is
because 99% of the time, these functions will always be called with
*application-frame* as the frame argument, so there's no need to make
it explicit in every call.
--- /project/climacs/cvsroot/esa/packages.lisp 2006/09/03 21:22:05 1.7
+++ /project/climacs/cvsroot/esa/packages.lisp 2006/09/08 18:08:03 1.8
@@ -17,18 +17,21 @@
(defpackage :esa-buffer
(:use :clim-lisp :clim :esa)
- (:export #:make-buffer-from-stream #:save-buffer-to-stream
+ (:export #:frame-make-buffer-from-stream #:make-buffer-from-stream
+ #:frame-save-buffer-to-stream #:save-buffer-to-stream
#:filepath #:name #:needs-saving #:file-write-time #:file-saved-p
#:esa-buffer-mixin
- #:make-new-buffer
+ #:frame-make-new-buffer #:make-new-buffer
#:read-only-p))
(defpackage :esa-io
(:use :clim-lisp :clim :esa :esa-buffer)
(:export #:buffers #:frame-current-buffer #:current-buffer
- #:find-file #:find-file-read-only
- #:set-visited-filename
- #:save-buffer #:write-buffer
+ #:frame-find-file #:find-file
+ #:frame-find-file-read-only #:find-file-read-only
+ #:frame-set-visited-filename #:set-visited-filename
+ #:frame-save-buffer #:save-buffer
+ #:frame-write-buffer #:write-buffer
#:esa-io-table))
#-mcclim
--- /project/climacs/cvsroot/esa/esa.asd 2006/05/10 09:52:05 1.5
+++ /project/climacs/cvsroot/esa/esa.asd 2006/09/08 18:08:03 1.6
@@ -4,5 +4,5 @@
(:file "colors" :depends-on ("packages"))
(:file "esa" :depends-on ("colors" "packages"))
(:file "esa-buffer" :depends-on ("packages" "esa"))
- (:file "esa-io" :depends-on ("packages" "esa"))
+ (:file "esa-io" :depends-on ("packages" "esa" "esa-buffer"))
(:file "esa-command-parser" :depends-on ("packages" "esa"))))
--- /project/climacs/cvsroot/esa/esa-io.lisp 2006/09/03 21:22:05 1.5
+++ /project/climacs/cvsroot/esa/esa-io.lisp 2006/09/08 18:08:03 1.6
@@ -31,19 +31,29 @@
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))
-(defgeneric save-buffer (buffer application-frame))
-(defgeneric write-buffer (buffer filepath application-frame))
+(defgeneric frame-find-file (application-frame file-path)
+ (:documentation "If a buffer with the file-path already exists,
+return it, else if a file with the right name exists, return a
+fresh buffer created from the file, else return a new empty
+buffer having the associated file name."))
+(defgeneric frame-find-file-read-only (application-frame file-path))
+(defgeneric frame-set-visited-file-name (application-frame filepath buffer))
+(defgeneric frame-save-buffer (application-frame buffer))
+(defgeneric frame-write-buffer (application-frame filepath buffer))
+
+(defun find-file (file-path)
+ (frame-find-file *application-frame* file-path))
+(defun find-file-read-only (file-path)
+ (frame-find-file-read-only *application-frame* file-path))
+(defun set-visited-file-name (filepath buffer)
+ (frame-set-visited-file-name *application-frame* filepath buffer))
+(defun save-buffer (buffer)
+ (frame-save-buffer *application-frame* buffer))
+(defun write-buffer (filepath buffer)
+ (frame-write-buffer *application-frame* filepath buffer))
(make-command-table 'esa-io-table :errorp nil)
-(defgeneric find-file (file-path application-frame)
- (:documentation "if a buffer with the file-path already exists, return it,
-else if a file with the right name exists, return a fresh buffer created from
-the file, else return a new empty buffer having the associated file name."))
-
(defun filename-completer (so-far mode)
(flet ((remove-trail (s)
(subseq s 0 (let ((pos (position #\/ s :from-end t)))
@@ -143,7 +153,7 @@
(concatenate 'string (pathname-name pathname)
"." (pathname-type pathname))))
-(defmethod find-file (filepath application-frame)
+(defmethod frame-find-file (application-frame filepath)
(cond ((null filepath)
(display-message "No file name given.")
(beep))
@@ -155,8 +165,8 @@
:key #'filepath :test #'equal)
(let ((buffer (if (probe-file filepath)
(with-open-file (stream filepath :direction :input)
- (make-buffer-from-stream stream *application-frame*))
- (make-new-buffer *application-frame*))))
+ (make-buffer-from-stream stream))
+ (make-new-buffer))))
(setf (filepath buffer) filepath
(name buffer) (filepath-filename filepath)
(needs-saving buffer) nil)
@@ -183,12 +193,12 @@
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."
- (find-file filepath *application-frame*))
+ (find-file filepath))
(set-key `(com-find-file ,*unsupplied-argument-marker*)
'esa-io-table '((#\x :control) (#\f :control)))
-(defmethod find-file-read-only (filepath application-frame)
+(defmethod frame-find-file-read-only (application-frame filepath)
(cond ((null filepath)
(display-message "No file name given.")
(beep))
@@ -200,7 +210,7 @@
:key #'filepath :test #'equal)
(if (probe-file filepath)
(with-open-file (stream filepath :direction :input)
- (let ((buffer (make-buffer-from-stream stream *application-frame*)))
+ (let ((buffer (make-buffer-from-stream stream)))
(setf (filepath buffer) filepath
(name buffer) (filepath-filename filepath)
(read-only-p buffer) t
@@ -221,7 +231,7 @@
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."
- (find-file-read-only filepath *application-frame*))
+ (find-file-read-only filepath))
(set-key `(com-find-file-read-only ,*unsupplied-argument-marker*)
'esa-io-table '((#\x :control) (#\r :control)))
@@ -236,9 +246,9 @@
(set-key 'com-read-only 'esa-io-table '((#\x :control) (#\q :control)))
-(defmethod set-visited-file-name (filename buffer application-frame)
- (setf (filepath buffer) filename
- (name buffer) (filepath-filename filename)
+(defmethod frame-set-visited-file-name (application-frame filepath buffer)
+ (setf (filepath buffer) filepath
+ (name buffer) (filepath-filename filepath)
(needs-saving buffer) t))
(define-command (com-set-visited-file-name :name t :command-table esa-io-table)
@@ -251,7 +261,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*))
+ (set-visited-file-name filename (current-buffer)))
(defun extract-version-number (pathname)
"Extracts the emacs-style version-number from a pathname."
@@ -288,7 +298,7 @@
nil))
t)))
-(defmethod save-buffer (buffer application-frame)
+(defmethod frame-save-buffer (application-frame buffer)
(let ((filepath (or (filepath buffer)
(accept 'pathname :prompt "Save Buffer to File"))))
(cond
@@ -297,7 +307,7 @@
(beep))
(t
(unless (check-file-times buffer filepath "Overwrite" "written")
- (return-from save-buffer))
+ (return-from frame-save-buffer))
(when (and (probe-file filepath) (not (file-saved-p buffer)))
(let ((backup-name (pathname-name filepath))
(backup-type (format nil "~A~~~D~~"
@@ -320,12 +330,12 @@
(let ((buffer (current-buffer)))
(if (or (null (filepath buffer))
(needs-saving buffer))
- (save-buffer buffer *application-frame*)
+ (save-buffer buffer)
(display-message "No changes need to be saved from ~a" (name buffer)))))
(set-key 'com-save-buffer 'esa-io-table '((#\x :control) (#\s :control)))
-(defmethod write-buffer (buffer filepath application-frame)
+(defmethod frame-write-buffer (application-frame filepath buffer)
(cond
((directory-pathname-p filepath)
(display-message "~A is a directory name." filepath))
@@ -344,7 +354,7 @@
"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)))
- (write-buffer buffer filepath *application-frame*)))
+ (write-buffer buffer filepath)))
(set-key `(com-write-buffer ,*unsupplied-argument-marker*)
'esa-io-table '((#\x :control) (#\w :control)))
--- /project/climacs/cvsroot/esa/esa-buffer.lisp 2006/08/20 10:08:23 1.2
+++ /project/climacs/cvsroot/esa/esa-buffer.lisp 2006/09/08 18:08:03 1.3
@@ -20,17 +20,31 @@
(in-package :esa-buffer)
-(defgeneric make-buffer-from-stream (stream application-frame)
+(defgeneric frame-make-buffer-from-stream (application-frame stream)
(:documentation "Create a fresh buffer by reading the external
representation from STREAM"))
-(defgeneric make-new-buffer (application-frame)
- (:documentation "Create a empty buffer for the application frame"))
+(defun make-buffer-from-stream (stream)
+ "Create a fresh buffer by reading the external representation
+from STREAM"
+ (frame-make-buffer-from-stream *application-frame* stream))
+
+(defgeneric frame-make-new-buffer (application-frame &key &allow-other-keys)
+ (:documentation "Create a empty buffer for the application frame."))
+
+(defun make-new-buffer (&key &allow-other-keys)
+ "Create a empty buffer for the current frame."
+ (frame-make-new-buffer *application-frame*))
-(defgeneric save-buffer-to-stream (buffer stream)
+(defgeneric frame-save-buffer-to-stream (application-frame buffer stream)
(:documentation "Save the entire BUFFER to STREAM in the appropriate
external representation"))
+(defun save-buffer-to-stream (buffer stream)
+ "Save the entire BUFFER to STREAM in the appropriate external
+representation"
+ (frame-save-buffer-to-stream *application-frame* buffer stream))
+
(defclass esa-buffer-mixin ()
((%filepath :initform nil :accessor filepath)
(%name :initarg :name :initform "*scratch*" :accessor name)
More information about the Climacs-cvs
mailing list