minor updates to work with released ucw-core
[clinton/lisp-on-lines.git] / src / standard-descriptions / list.lisp
CommitLineData
4358148e 1(in-package :lisp-on-lines)
2
2548f054 3
4(define-layered-class list-attribute (standard-attribute)
5 ((item-args :initform nil :initarg :item :layered t :special t)))
6
7(define-layered-method display-attribute-value
8 ((attribute list-attribute))
46440824 9 (generic-format *display* "(")
10 (let ((list (attribute-value attribute)))
11
12 (loop
13 :for cons :on list
14 :do (let ((item (first cons
15)))
16 (break "Display T ~A" item)
17 (dletf (((attribute-object attribute) item))
18 (apply #'display *display* item (slot-value attribute 'item-args))
19 (unless (endp (cdr cons))
20 (generic-format *display* " "))))))
21 (generic-format *display* ")"))
22
23
24
25
26
2548f054 27
28(define-description list ()
29 ((list :attribute-class list-attribute
30 :function #'identity
31 :attributes nil)))
32
33(define-description cons (list)
4358148e 34 ((car :label "First" :function #'car)
2548f054 35 (cdr :label "Rest" :function #'cdr)
36 ))
4358148e 37
38(define-description cons ()
39 ((editp :value t :editp nil)
40 (car :setter #'rplaca)
41 (cdr :setter #'rplacd))
42 (:in-description editable))
43
2548f054 44(define-description cons ()
45 ((active-attributes :value '(list)))
46 (:in-description inline))
47
4358148e 48(define-layered-method description-of ((c cons))
49 (find-description 'cons))
50
51
52
53
54
55