(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)))
+
-#+nil(mapcar (lambda (slotd)
- (slot-value-using-class (class-of description) description slotd))
- (class-slots (class-of description)))
(defun description-attributes (description)
- (mapcar #'attribute-object (class-slots (class-of description))))
+ (let ((class (class-of description)))
+ (loop :for slot :in (class-slots class)
+ :if (and
+ (not (eq 'described-object
+ (slot-definition-name slot))))
+ :collect (slot-definition-attribute-object slot))))
+
+
(define-layered-function attributes (description)
(:method (description)
- (remove-if-not
- (lambda (attribute)
- (and (eq (class-of description)
- (print (slot-value attribute 'description-class)))
- (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 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.
(destructuring-bind (&optional slots &rest options) options
(let ((description-layers (cdr (assoc :in-description options))))
(if description-layers
- `(eval-when (:compile-toplevel :load-toplevel :execute)
+ `(progn ;eval-when (:compile-toplevel :load-toplevel :execute)
,@(loop
:for layer
:in description-layers
,@(acons
:in-layer (defining-description layer)
(remove :in-description options :key #'car)))))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
+ `(progn ;eval-when (:compile-toplevel :load-toplevel :execute)
; `(progn
(defclass ,description-name
,(append (mapcar #'defining-description