1 (in-package :lisp-on-lines
)
3 (define-description standard-object
()
4 ((class-slots :label
"Slots"
5 :function
(compose 'class-slots
'class-of
))))
7 (define-layered-class slot-definition-attribute
(standard-attribute)
8 ((slot-name :initarg
:slot-name
:accessor attribute-slot-name
)))
10 (define-layered-method attribute-value
(object (attribute slot-definition-attribute
))
11 (if (slot-boundp object
(attribute-slot-name attribute
))
13 (slot-value object
(attribute-slot-name attribute
))
14 (gensym "UNBOUND-SLOT-")))
16 (defmacro define-description-for-class
(class-name &optional
(name (intern (format nil
"DESCRIPTION-FOR-~A" class-name
))))
18 (define-description ,name
(standard-object)
19 ,(loop :for slot in
(class-slots (find-class class-name
))
20 :collect
`(,(slot-definition-name slot
)
21 :attribute-class slot-definition-attribute
22 :slot-name
,(slot-definition-name slot
)
23 :label
,(slot-definition-name slot
)))
25 (unless (ignore-errors (find-description ',class-name
))
26 (define-description ,class-name
(,name
) ()))))
30 (define-layered-method description-of
((object standard-object
))
31 (or (ignore-errors (find-description (class-name (class-of object
))))
32 (find-description 'standard-object
)))