1 (in-package :lisp-on-lines
)
3 (define-description T
()
4 ((identity :label nil
:function
#'identity
)
5 (type :label
"Type of" :function
#'type-of
)
6 (class :label
"Class" :function
#'class-of
)
7 (active-attributes :label
"Attributes"
10 :keyword
:attributes
)))
12 (define-layered-method description-of
(any-lisp-object)
13 (find-description 't
))
15 (define-layered-function display-attribute
(object attribute
)
16 (:method
(object attribute
)
17 (display-using-description attribute
*display
* object
)))
19 (define-layered-function display-attribute-label
(object attribute
)
20 (:method
(object attribute
)
21 (format *display
* "~A " (attribute-label attribute
))))
23 (define-layered-function display-attribute-value
(object attribute
)
24 (:method
(object attribute
)
25 (let ((val (attribute-value attribute
)))
27 (format *display
* "~A " val
)
28 (with-active-descriptions (inline)
29 (display *display
* val
))))))
31 (define-layered-method display-using-description
32 ((attribute standard-attribute
) display object
&rest args
)
33 (declare (ignore args
))
34 (when (attribute-label attribute
)
35 (display-attribute-label object attribute
))
36 (display-attribute-value object attribute
))
38 (define-display ((description t
))
39 (format *display
* "~{~A~%~}"
42 (with-output-to-string (*display
*)
43 (display-attribute *object
* attribute
)))
44 (attributes description
))))