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