(with-function-access
(slot-value-using-class class attribute property))
(funcall fn layer (attribute-description attribute)))
- (funcall fn layer (attribute-description attribute))))))
+ (handler-case (funcall fn layer (attribute-description attribute))
+ (error ()
+ (warn "Error calling ~A" fn)))))))
(mapcar
(lambda (slot)
(or (find-attribute description
- (slot-definition-name slot))
+ (slot-definition-name slot) nil)
(let* ((*init-time-description* description)
(attribute-class (or
(ignore-errors
initargs )
(setf (slot-value description (attribute-name attribute))
(attribute-class attribute))
- (apply #'change-class attribute (attribute-class attribute)
+ (apply #'change-class attribute (find-class (attribute-class attribute))
initargs)))))))))
(print-unreadable-object (object stream :type t :identity t)
(princ (ignore-errors (description-print-name (find-layer object))) stream)))
-(defun find-description (name)
- (find-layer (find-class (defining-description name))))
+(defun find-description (name &optional (errorp t))
+ (let ((class (find-class (defining-description name) errorp)))
+ (when class (find-layer class))))
#'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))