add patch for proper attribute classes origin/HEAD origin/master
authorDrew Crampsie <drewc@neptune.(none)>
Sat, 10 Apr 2010 00:45:15 +0000 (17:45 -0700)
committerDrew Crampsie <drewc@neptune.(none)>
Sat, 10 Apr 2010 00:45:15 +0000 (17:45 -0700)
src/mao/description-class.lisp

index 1dbc902..4858ab8 100644 (file)
@@ -80,6 +80,7 @@
 (defmethod description-class-attribute-class (description)
   'standard-attribute)
 
 (defmethod description-class-attribute-class (description)
   'standard-attribute)
 
+
 (defmethod initialize-slot-definition-attribute 
     (class (slotd effective-attribute-slot-definition-class) 
      name direct-slot-definitions)
 (defmethod initialize-slot-definition-attribute 
     (class (slotd effective-attribute-slot-definition-class) 
      name direct-slot-definitions)
                 (append (gethash (slot-definition-layer ds) tbl '()) 
                         (slot-definition-attribute-properties ds))))
 
                 (append (gethash (slot-definition-layer ds) tbl '()) 
                         (slot-definition-attribute-properties ds))))
 
-    (let* ((attribute-class (or (getf (gethash t tbl) :attribute-class)
+    (let* ((attribute-class (or (block nil  
+                                 (maphash (lambda (k v)
+                                            (let ((class (getf v :attribute-class)))
+                                              (when class (return class))))
+                                          tbl))
                                (description-class-attribute-class class)))
           (attribute (apply #'make-instance attribute-class :name name 'description-class class (gethash t tbl))))
       (maphash (lambda (layer properties)
                                (description-class-attribute-class class)))
           (attribute (apply #'make-instance attribute-class :name name 'description-class class (gethash t tbl))))
       (maphash (lambda (layer properties)