removing historical implementation
[clinton/lisp-on-lines.git] / src / standard-display.lisp
CommitLineData
dee565d0
DC
1(in-package :lisp-on-lines)
2
1d51a2ee 3(deflayer lisp-on-lines ())
4
2b0fd9c8 5;;;; The Standard Layers
1d51a2ee 6(deflayer viewer (lisp-on-lines))
7(deflayer editor (lisp-on-lines))
a4e6154d 8
1cc831d4 9;;;; Attributes
10(defdisplay
11 :in-layer editor
12 ((attribute standard-attribute) object)
13 (call-next-method))
14
15(defdisplay
16 ((attribute standard-attribute) object component)
17 (<:as-html (attribute-value object attribute)))
18
19(define-layered-method display-using-description
20 ((attribute standard-attribute) object component)
21 (with-component (component)
22 )
23 (<:as-html (attribute-value object attribute)))
24
e1645f63 25(define-layered-method label (anything)
26 nil)
27
a4e6154d
DC
28(defdisplay
29 :in-layer editor :around (description object)
e1645f63 30 "It is useful to remove the viewer layer when in the editing layer.
fb04c0a8 31This allows us to dispatch to a subclasses editor.
32"
e1645f63 33 (with-inactive-layers (viewer)
34 (call-next-method)))
a4e6154d 35
e1645f63 36;;;; These layers affect the layout of the object
dee565d0 37(deflayer one-line)
14a7e1bc 38(deflayer as-table)
2b0fd9c8 39(deflayer as-string)
14a7e1bc 40
1cc831d4 41(defdisplay
42 :in-layer as-string (d o (self t))
43 (with-output-to-string (yaclml::*yaclml-stream*)
44 (do-attributes (a d)
45 (display-attribute a o)
46 (<:as-html " "))
47 #+nil (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
48)))
49
50
2b0fd9c8
DC
51(defdisplay
52 :in-layer as-string (d o)
1cc831d4 53 (with-output-to-string (yaclml::*yaclml-stream*)
a4e6154d
DC
54 (do-attributes (a d)
55 (display-attribute a o)
1cc831d4 56 (<:as-html " "))
57 #+nil (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
58)))
dee565d0 59
2b0fd9c8
DC
60(defmethod list-slots (thing)
61 (list 'identity))
d1b0ed7c 62
87e47dd6
DC
63;;;; * Object displays.
64
a4e6154d 65
dee565d0 66
2b0fd9c8 67;;;; TODO: all lisp types should have occurences and attributes defined for them.
dee565d0 68
2b0fd9c8
DC
69(defdisplay ((description t) lisp-value)
70 (<:as-html lisp-value))
14a7e1bc 71
2b0fd9c8 72(defdisplay (description (object string))
dee565d0
DC
73 (<:as-html object))
74
ff1e971a 75(defdisplay (description (object symbol))
76 (<:as-html object))
77
2b0fd9c8
DC
78(defdisplay (description object (component t))
79 "The default display for CLOS objects"
80 (print (class-name (class-of object)))
81 (dolist* (slot-name (list-slots object))
2b0fd9c8
DC
82 (let ((boundp (slot-boundp object slot-name)))
83 (format t "~A~A : ~A" (strcat slot-name)
84 (if boundp
85 ""
86 "(unbound)")
87 (if boundp
88 (slot-value object slot-name) "")))))
89
90(defdisplay ((description t) object)
91 "The default display for CLOS objects in UCW components"
92 (dolist* (slot-name (list-slots object))
93
94 (let ((boundp (slot-boundp object slot-name)))
95 (<:label :class "lol-label"
96 (display-attribute 'label (strcat slot-name))
97 (if boundp
98 ""
99 "(unbound)"))
100 (<:as-html
101 (if boundp
102 (slot-value object slot-name) "")))))
103
104;;;; ** The default displays for objects with a MEWA occurence
105
106(defdisplay (description object)
107 (<:div
a4e6154d
DC
108 :class "lol-display"
109 (when (label description)
110 (<:span
111 :class "title"
112 (<:as-html (label description))))
2b0fd9c8
DC
113 (do-attributes (attribute description)
114 (<:div
a4e6154d 115 :class "attribute"
2b0fd9c8 116 (display-attribute attribute object)))))
60a24293 117
14a7e1bc 118;;;; ** One line
2b0fd9c8 119(defdisplay
e1645f63 120 :in-layer one-line (description object)
121 "The one line presentation just displays the attributes with a #\Space between them"
122 (do-attributes (attribute description)
123 (display-attribute attribute object)
124 (<:as-html " ")))
14a7e1bc
DC
125
126;;;; ** as-table
127
2b0fd9c8
DC
128(defdisplay :in-layer as-table (description object)
129 (<:table
130 (do-attributes (a description)
14a7e1bc 131 (<:tr
2b0fd9c8
DC
132 (<:td :class "lol-label" (<:as-html (label a)))
133 (<:td (display-attribute a object))))))
14a7e1bc
DC
134
135;;;; List Displays
e1645f63 136
1cc831d4 137#| (deflayer list-display-layer)
e1645f63 138
139(define-layered-class description
140 :in-layer list-display-layer ()
fb04c0a8 141 ((list-item :initarg :list-item
142 :initarg :table-item
143 :initform nil
144 :special t
145 :accessor list-item)))
e1645f63 146
2b0fd9c8 147(defdisplay (desc (list list))
e1645f63 148 (with-active-layers (list-display-layer)
e1645f63 149 (<:ul
150 (dolist* (item list)
151 (<:li (apply #'display* item (list-item desc)))))))
dee565d0 152
fb04c0a8 153(defdisplay :in-layer as-table (description (list list))
154 (with-active-layers (list-display-layer)
155 (let ((item-description (find-occurence (first list))))
156 (<:table
157 (funcall
158 (apply #'lol::make-display-function self (first list)
159 (list-item description))
160 (lambda (desc item component)
161 (<:tr
162 (do-attributes (a desc)
163 (<:th (<:as-html (label a)))))
164
165 (dolist* (obj list)
166 (<:tr
167 (do-attributes (a desc)
1cc831d4 168 (<:td (display-attribute a obj))))))))))) |#
fb04c0a8 169
dee565d0 170
87e47dd6 171
dee565d0 172
14a7e1bc 173
dee565d0 174
dee565d0 175
dee565d0
DC
176
177
178
179
180
181