ARNESI

Mesing with the MOP 

(defmacro with-class-slots ((object class-name &key except) &body body)
  "Execute BODY as if in a with-slots form containig _all_ the
  slots of (find-clas CLASS-NAME). This macro, which is something
  of an ugly hack, inspects the class named by CLASS-NAME at
  macro expansion time. Should the class CLASS-NAME change form
  containing WITH-CLASS-SLOTS must be recompiled. Should the
  class CLASS-NAME not be available at macro expansion time
  WITH-CLASS-SLOTS will fail."
  (declare (ignore object class-name except body))
  (error "Not yet implemented."))

wrapping-standard method combination 

(define-method-combination wrapping-standard
    (&key (around-order :most-specific-first)
          (before-order :most-specific-first)
          (primary-order :most-specific-first)
          (after-order :most-specific-last)
          (wrapping-order :most-specific-last))
  ((around (:around))
   (before (:before))
   (wrapping (:wrapping))
   (primary () :required t)
   (after (:after)))
  "Same semantics as standard method combination but allows
\"wrapping\" methods which get called before :around methods and
in :most-specific-last order.

Ordering of methods:

 (around
    (before)
    (wrapping
      (primary))
    (after))

:around, :wrapping and :primary methods call the next least/most
specific method via call-next-method (as in standard method
combination).

The order of method application is settable via parameters to
the :method-combination argument of the defgeneric which uses
this method combination.

The various WHATEVER-order keyword arguments set the order in
which the methods are called and be set to 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))
           (wrapping (effective-order wrapping wrapping-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 wrapping
        ;; wrap form in call to the wrapping methods
        (setf form `(call-method ,(first wrapping)
                                 (,@(rest wrapping) (make-method ,form)))))
      (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)))