[climacs-cvs] CVS esa

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)