A metaclass for weblocks-webapps

defwebapp in weblocks-dev currently does many mysterious things with its keyword arguments. But these are the sorts of things that should be given directly to make-instance, so that you can use your own defclass forms and your own make-instance calls to construct weblocks-webapp instances in creative ways.

I have a few goals for a rewrite of defwebapp:

1. Trivialize the mapping of the defwebapp form to a defclass form, putting most of the logic in initializing methods and possibly a metaclass (ahem, class metaobject class).
2. Don't hide the default slot values in class-default-initargs.
   
3. On reevaluation of defwebapp, replace the slot values, at least in the trivial case where the hacker allowed the normal autostarter to instantiate the resulting weblocks-webapp subclass.
   

My first thought, abandoned before I could even start changing defwebapp proper to use it, would have defwebapp fill class-instance slots (not to be confused with instance slots with :allocation :class) instead of default-initargs, then alter the initform and initfunction in compute-effective-slot-definition to copy over those values to each new instance.

(defclass weblocks-webapp-class (standard-class)
  ())

(defmethod validate-superclass ((class weblocks-webapp-class) superclass)
  (typep (class-name (class-of superclass))
         '(member standard-class weblocks-webapp-class)))

(defgeneric class-defaulting-slots (class)
  (:method ((self weblocks-webapp-class))
    (loop for class in (class-precedence-list self)
       while (typep class 'weblocks-webapp-class)
       append (class-direct-slots class)))
  (:method ((self standard-class)) '()))

(defmethod compute-effective-slot-definition
    ((self weblocks-webapp-class) name direct-slot-defns)
  "Provide a default initform (read the class's version of the slot)
for those without initforms."
  (let ((eslot (call-next-method))
        (defaulting-slots (class-defaulting-slots self)))
    (macrolet ((initfunc () (slot-definition-initfunction eslot)))
      (when (and (find name defaulting-slots :key #'slot-definition-name)
                 (not (initfunc)))
        (setf (slot-definition-initform eslot)
              `(slot-value (find-class ',(class-name self)) ',name)
              (initfunc) (lambda () (slot-value self name)))))
    eslot))