(define-method-combination quasi-standard (&key (around-order :most-specific-first) (before-order :most-specific-first) (primary-order :most-specific-first) (after-order :most-specific-last)) ((around (:around)) (before (:before)) (primary () :required-t) (after (:after))) "Same semantics as standard method combination but the order of method application is settable.
This method combination takes four arguments which allow you to change the order in which around, before, primary and after methods are called. The values of the keyword parameters must all be either :most-specific-last or :most-specific-first." (labels ((effective-order (methods order) (ecase order (:most-specific-first methods) (:most-specific-last (reverse methods)))) (call-methods (methods) (mapcar (lambda (meth) `(call-method ,meth)) methods))) (let* (;; reorder the methods based on the -order arguments (around (effective-order around around-order)) (before (effective-order before before-order)) (primary (effective-order primary primary-order)) (after (effective-order after after-order)) ;; inital value of the effective call is a call its primary ;; method(s) (form (case (length primary) (1 `(call-method ,(first primary))) (t `(call-method ,(first primary) ,(rest primary)))))) (when before ;; wrap FORM in calls to its before methods (setf form `(progn ,@(call-methods before) ,form))) (when after ;; wrap FORM in calls to its after methods (setf form `(multiple-value-prog1 ,form ,@(call-methods after)))) (when around ;; wrap FORM in calls to its around methods (setf form `(call-method ,(first around) (,@(rest around) (make-method ,form))))) form)))