checkpoint.. nothing to see here.
[clinton/lisp-on-lines.git] / src / standard-descriptions / clos.lisp
1 (in-package :lisp-on-lines)
2
3 (define-description standard-object ()
4 ((class-slots :label "Slots"
5 :function (compose 'class-slots 'class-of))))
6
7 (define-layered-class slot-definition-attribute (standard-attribute)
8 ((slot-name :initarg :slot-name :accessor attribute-slot-name)))
9
10 (define-layered-method attribute-value (object (attribute slot-definition-attribute))
11 (if (slot-boundp object (attribute-slot-name attribute))
12
13 (slot-value object (attribute-slot-name attribute))
14 (gensym "UNBOUND-SLOT-")))
15
16 (defmacro define-description-for-class (class-name &optional (name (intern (format nil "DESCRIPTION-FOR-~A" class-name))))
17 `(progn
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)))
24 (:mixinp t))
25 (unless (ignore-errors (find-description ',class-name))
26 (define-description ,class-name (,name) ()))))
27
28
29
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)))
33
34
35
36