Changes from maxclaims branch (git).
[clinton/lisp-on-lines.git] / src / description.lisp
index b64f611..d373ace 100644 (file)
           #'attribute-active-p
           (description-attributes description)))
 
-(defun find-attribute (description attribute-name)
-  (find attribute-name (description-attributes description)
-       :key #'attribute-name))
+(defun find-attribute (description attribute-name &optional (errorp t))
+  (or (find attribute-name (description-attributes description)
+           :key #'attribute-name)
+      (when errorp (error "No attribute named ~A found in ~A" attribute-name description))))
 
 (define-layered-function description-active-descriptions (description)
   (:method ((description standard-description-object))
            (find-attribute description 'active-attributes))
           (attributes (when active-attributes
                         (ignore-errors (attribute-value 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))))))
+      (remove-if-not 
+       (lambda (attribute)
+        (and attribute
+             (attribute-active-p attribute)                 
+             (some #'layer-active-p 
+                   (mapcar #'find-layer 
+                           (slot-definition-layers 
+                            (attribute-effective-attribute-definition attribute))))))
+       (if attributes
+          (mapcar (lambda (spec)                   
+                    (find-attribute 
+                     description
+                     (if (listp spec)
+                         (car spec)
+                         spec)))
+                  attributes)
           (description-attributes description))))))