From: Drew Crampsie <drewc@neptune.(none)>
Date: Sat, 10 Apr 2010 00:45:15 +0000 (-0700)
Subject: add patch for proper attribute classes
X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/commitdiff_plain/f8bb47ccfef28f3499f6fce182d0bd65b3ff8d22

add patch for proper attribute classes
---

diff --git a/src/mao/description-class.lisp b/src/mao/description-class.lisp
index 1dbc902..4858ab8 100644
--- a/src/mao/description-class.lisp
+++ b/src/mao/description-class.lisp
@@ -80,6 +80,7 @@
 (defmethod description-class-attribute-class (description)
   'standard-attribute)
 
+
 (defmethod initialize-slot-definition-attribute 
     (class (slotd effective-attribute-slot-definition-class) 
      name direct-slot-definitions)
@@ -90,7 +91,11 @@
 		 (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)