API CHANGE: Removed the OBJECT arg from attribute-value
[clinton/lisp-on-lines.git] / src / standard-descriptions / t.lisp
... / ...
CommitLineData
1(in-package :lisp-on-lines)
2
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"
8 :value nil
9 :activep nil
10 :keyword :attributes)))
11
12(define-layered-method description-of (any-lisp-object)
13 (find-description 't))
14
15(define-layered-function display-attribute (object attribute)
16 (:method (object attribute)
17 (display-using-description attribute *display* object)))
18
19(define-layered-function display-attribute-label (object attribute)
20 (:method (object attribute)
21 (format *display* "~A " (attribute-label attribute))))
22
23(define-layered-function display-attribute-value (object attribute)
24 (:method (object attribute)
25 (let ((val (attribute-value attribute)))
26 (if (eql val object)
27 (format *display* "~A " val)
28 (with-active-descriptions (inline)
29 (display *display* val))))))
30
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))
37
38(define-display ((description t))
39 (format *display* "~{~A~%~}"
40 (mapcar
41 (lambda (attribute)
42 (with-output-to-string (*display*)
43 (display-attribute *object* attribute)))
44 (attributes description))))
45
46
47