X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/80fcd57c2870eac29dc3e21849d358b6b58adcf8..6de8d30004efc9337b8c40d2ff2d0a76651d23eb:/src/description.lisp

diff --git a/src/description.lisp b/src/description.lisp
index c06a6f4..d19b92e 100644
--- a/src/description.lisp
+++ b/src/description.lisp
@@ -8,7 +8,8 @@
   (description-class-name (class-of description)))
 
 (defun find-attribute (description attribute-name)
-  (slot-value description attribute-name))
+  (when (slot-exists-p description attribute-name) 
+    (slot-value description attribute-name)))
 
 
 (defun description-attributes (description)
@@ -18,21 +19,34 @@
 	   description) 
 	  (class-slots (class-of description))))
 
-(defvar *display-attributes* nil)
-(defun attribute-active-p (attribute)
-  (or (null *display-attributes*)
-      (find (attribute-name attribute) *display-attributes*)))
+
 
 (define-layered-function attributes (description)
   (:method (description)
-    (remove-if-not 
-     (lambda (attribute)
-       (and (attribute-active-p attribute)
-	    (some #'layer-active-p 
-	     (mapcar #'find-layer 
-		     (slot-definition-layers 
-		      (attribute-effective-attribute-definition attribute))))))
-     (description-attributes description))))
+    (let* ((active-attributes 
+	    (find-attribute description 'active-attributes))
+	   (attributes (when active-attributes
+	     (attribute-value *object* active-attributes))))
+      (if attributes
+	  (mapcar (lambda (spec)		    
+		    (find-attribute 
+		     description
+		     (if (listp spec)
+			 (car spec)
+			 spec)))
+		  attributes)
+	  (remove-if-not 
+	   (lambda (attribute)
+	     (and (attribute-active-p attribute)		     
+		  (some #'layer-active-p 
+			(mapcar #'find-layer 
+				(slot-definition-layers 
+				 (attribute-effective-attribute-definition attribute))))))
+	   (description-attributes description))))))
+	  
+
+
+  
 
   
 ;;; A handy macro.