Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv12937/ESA
Modified Files: packages.lisp utils.lisp Log Message: Changed the update-syntax protocol to use a nonstandard method combination for added job security.
--- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/01/01 18:43:36 1.9 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/01/07 22:01:59 1.10 @@ -44,6 +44,7 @@ #:subtype-compatible-p #:capitalize #:ensure-array-size + #:values-max-min #:observable-mixin #:add-observer #:remove-observer #:observer-notified #:notify-observers --- /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/01/01 18:43:36 1.6 +++ /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/01/07 22:01:59 1.7 @@ -233,6 +233,34 @@ do (setf (elt array i) (funcall new-elem-fn))))) array)
+(define-method-combination values-max-min + (&optional (order ':most-specific-last)) + ((around (:around)) + (before (:before)) + (after (:after)) + (primary (values-max-min) :order order :required t)) + (flet ((call-methods (methods) + (mapcar (lambda (m) `(call-method ,m)) methods)) + (call-vmm-methods (methods) + `(multiple-value-bind (max min) + (call-method ,(first methods)) + (progn + ,@(loop for m in (rest methods) + collect `(multiple-value-bind (mmax mmin) + (call-method ,m) + (setq max (max max mmax) + min (min min mmin))))) + (values max min)))) + (let ((form (if (or around before after (rest primary)) + `(multiple-value-prog1 + (progn ,@(call-methods before) + ,(call-vmm-methods primary)) + (progn ,@(call-methods (reverse after)))) + `(call-method ,(first primary))))) + (if around + `(call-method ,(first around) (,@(rest around) (make-method ,form))) + form)))) + (defclass observable-mixin () ((%observers :accessor observers :initform '()))