+ (slot-value object (attribute-slot-name attribute))
+ (gensym "UNBOUND-SLOT-")))
+
+(defun ensure-description-for-class (class &optional (name (intern (format nil "DESCRIPTION-FOR-~A" (class-name class)))))
+ (let ((desc-class
+ (ensure-class (defining-description name)
+ :direct-superclasses (list (class-of (find-description 'standard-object)))
+ :direct-slots (loop :for slot in (class-slots class)
+ :collect `(:name ,(slot-definition-name slot)
+ :attribute-class slot-definition-attribute
+ :slot-name ,(slot-definition-name slot)
+ :label ,(slot-definition-name slot))
+ :into slots
+ :collect (slot-definition-name slot) :into names
+ :finally (return (cons `(:name active-attributes
+ :value ,names)
+ slots)))
+ :metaclass 'standard-description-class)))
+
+ (unless (ignore-errors (find-description (class-name class)))
+ (ensure-class (defining-description (class-name class))
+ :direct-superclasses (list desc-class)
+ :metaclass 'standard-description-class))
+ (find-description name)))
+