Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv13736/ESA
Modified Files: utils.lisp packages.lisp esa.lisp esa-buffer.lisp Log Message: Changed Drei to use a view-based paradigm, didn't make any significant changes to ESA just yet.
--- /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2007/08/13 21:56:04 1.3 +++ /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2007/12/08 08:53:48 1.4 @@ -18,7 +18,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA.
-;;; Miscellaneous utilities used in Climacs. +;;; Miscellaneous utilities used in ESA.
(in-package :esa-utils)
@@ -212,3 +212,99 @@ specifiers." (some (lambda (x) (subtypep x `(and ,@types))) types)) + +(defclass observable-mixin () + ((%observers :accessor observers + :initform '())) + (:documentation "A mixin class that adds the capability for a +subclass to have a list of "event subscribers" (observers) that +can be informed via callback (the function `observer-notified') +whenever the state of the object changes. The order in which +observers will be notified is undefined.")) + +(defgeneric add-observer (observable observer) + (:documentation "Add an observer to an observable object. If +the observer is already observing `observable', it will not be +added again.")) + +(defmethod add-observer ((observable observable-mixin) observer) + ;; Linear in complexity, perhaps a transparent switch to a hash + ;; table would be a good idea for large amounts of observers. + (pushnew observer (observers observable))) + +(defgeneric remove-observer (observable observer) + (:documentation "Remove an observer from an observable +object. If observer is not in the list of observers of +`observable', nothing will happen.")) + +(defmethod remove-observer ((observable observable-mixin) observer) + (setf (observers observable) + (delete observer (observers observable)))) + +(defgeneric observer-notified (observer observable data) + (:documentation "This function is called by `observable' when +its state changes on each observer that is observing +it. `Observer' is the observing object, `observable' is the +observed object. `Data' is arbitrary data that might be of +interest to `observer', it is recommended that subclasses of +`observable-mixin' specify exactly which form this data will +take, the observer protocol does not guarantee anything. It is +non-&optional so that methods may be specialised on it, if +applicable. The default method on this function is a no-op, so it +is never an error to not define a method on this generic function +for an observer.") + (:method (observer (observable observable-mixin) data) + ;; Never a no-applicable-method error. + nil)) + +(defgeneric notify-observers (observable &optional data-fn) + (:documentation "Notify each observer of `observable' by +calling `observer-notified' on them. `Data-fn' will be called, +with the observer as the single argument, to obtain the `data' +argument to `observer-notified'. The default value of `data-fn' +should cause the `data' argument to be NIL.")) + +(defmethod notify-observers ((observable observable-mixin) + &optional (data-fn (constantly nil))) + (dolist (observer (observers observable)) + (observer-notified observer observable + (funcall data-fn observer)))) + +(defclass name-mixin () + ((%name :accessor name + :initarg :name + :type string + :documentation "The name of the named object.")) + (:documentation "A class used for defining named objects.")) + +(defclass subscriptable-name-mixin (name-mixin) + ((%subscript :accessor subscript + :documentation "The subscript of the named object.") + (%subscript-generator :accessor subscript-generator + :initarg :subscript-generator + :initform (constantly 1) + :documentation "A function used for +finding the subscript of a `name-mixin' whenever the name is +set (including during object initialization). This function will +be called with the name as the single argument.")) + (:documentation "A class used for defining named objects. A +facility is provided for assigning a named object a "subscript" +uniquely identifying the object if there are other objects of the +same name in its collection (in particular, if an editor has two +buffers with the same name).")) + +(defmethod initialize-instance :after ((name-mixin subscriptable-name-mixin) + &rest initargs) + (declare (ignore initargs)) + (setf (subscript name-mixin) + (funcall (subscript-generator name-mixin) (name name-mixin)))) + +(defmethod subscripted-name ((name-mixin subscriptable-name-mixin)) + ;; Perhaps this could be written as a single format statement? + (if (/= (subscript name-mixin) 1) + (format nil "~A <~D>" (name name-mixin) (subscript name-mixin)) + (name name-mixin))) + +(defmethod (setf name) :after (new-name (name-mixin subscriptable-name-mixin)) + (setf (subscript name-mixin) + (funcall (subscript-generator name-mixin) new-name))) --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2007/11/19 20:34:10 1.5 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2007/12/08 08:53:48 1.6 @@ -41,7 +41,12 @@ #:invoke-with-dynamic-bindings-1 #:invoke-with-dynamic-bindings #:maptree - #:subtype-compatible-p)) + #:subtype-compatible-p + #:observable-mixin + #:add-observer #:remove-observer + #:observer-notified #:notify-observers + #:name-mixin #:name + #:subscriptable-name-mixin #:subscripted-name #:subscript #:subscript-generator))
(defpackage :esa (:use :clim-lisp :clim :esa-utils) --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/11/19 20:28:43 1.11 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/12/08 08:53:48 1.12 @@ -41,10 +41,18 @@ (defgeneric esa-current-buffer (esa) (:documentation "Return the current buffer of APPLICATION-FRAME."))
+(defgeneric (setf esa-current-buffer) (new-buffer esa) + (:documentation "Replace the current buffer of +APPLICATION-FRAME with NEW-BUFFER.")) + (defun current-buffer () "Return the currently active buffer of the running ESA." (esa-current-buffer *esa-instance*))
+(defun (setf current-buffer) (new-buffer) + "Return the currently active buffer of the running ESA." + (setf (esa-current-buffer *esa-instance*) new-buffer)) + (defgeneric windows (esa) (:documentation "Return a list of all the windows of the ESA.") (:method ((esa application-frame)) --- /project/mcclim/cvsroot/mcclim/ESA/esa-buffer.lisp 2007/11/13 13:05:38 1.2 +++ /project/mcclim/cvsroot/mcclim/ESA/esa-buffer.lisp 2007/12/08 08:53:48 1.3 @@ -45,10 +45,10 @@ representation" (frame-save-buffer-to-stream *application-frame* buffer stream))
-(defclass esa-buffer-mixin () +(defclass esa-buffer-mixin (name-mixin) ((%filepath :initform nil :accessor filepath) - (%name :initarg :name :initform "*scratch*" :accessor name) (%needs-saving :initform nil :accessor needs-saving) (%file-write-time :initform nil :accessor file-write-time) (%file-saved-p :initform nil :accessor file-saved-p) - (%read-only-p :initform nil :accessor read-only-p))) + (%read-only-p :initform nil :accessor read-only-p)) + (:default-initargs :name "*scratch*"))