subclass UCW's form classes in the editor layer.
[clinton/lisp-on-lines.git] / src / mewa.lisp
index 7bb9522..7c712ef 100644 (file)
@@ -115,8 +115,6 @@ Attributes are the metadata used to display, validate, and otherwise manipulate
       (defmethod find-attribute-class-for-type ((type (eql ',type)))
        ',name))))
 
       (defmethod find-attribute-class-for-type ((type (eql ',type)))
        ',name))))
 
-
-
 (define-layered-class
     display-attribute (attribute)
     ()
 (define-layered-class
     display-attribute (attribute)
     ()
@@ -263,11 +261,10 @@ otherwise, (setf find-attribute)"
               (when (slot-boundp instance (attribute.name attribute))
                 (slot-value instance (attribute.name attribute)))))))
 
               (when (slot-boundp instance (attribute.name attribute))
                 (slot-value instance (attribute.name attribute)))))))
 
-(define-layered-function (setf attribute-value)  (value instance attribute))
+(define-layered-function (setf attribute-value) (value instance attribute))
 
 (define-layered-method
     (setf attribute-value) (value instance (attribute standard-attribute))
 
 (define-layered-method
     (setf attribute-value) (value instance (attribute standard-attribute))
-              
   (with-slots (setter slot-name) attribute 
     (cond ((and (slot-boundp attribute 'setter) setter)
 
   (with-slots (setter slot-name) attribute 
     (cond ((and (slot-boundp attribute 'setter) setter)
 
@@ -280,6 +277,7 @@ otherwise, (setf find-attribute)"
           (error "Cannot set ~A in ~A" attribute instance)))))
 
 
           (error "Cannot set ~A in ~A" attribute instance)))))
 
 
+
 ;;;; ** Default Attributes
 
 
 ;;;; ** Default Attributes
 
 
@@ -505,7 +503,6 @@ in that object presentation."
                       type) 
                   (plist-union initargs (when a
                                           (description.properties a))))))
                       type) 
                   (plist-union initargs (when a
                                           (description.properties a))))))
-    (warn "attribute? ~A ~A " (and a (description.type  (find-attribute object type)) )                                           (description.properties a))
     (setf (slot-value i 'instance) object)
     (initialize-slots i)
     (setf (slot-value i 'initializedp) t)
     (setf (slot-value i 'instance) object)
     (initialize-slots i)
     (setf (slot-value i 'initializedp) t)