Commit | Line | Data |
---|---|---|
7733a777 DC |
1 | (in-package :lisp-on-lines) |
2 | ||
e1645f63 | 3 | ;;;; A few layers related to attributes |
2b0fd9c8 DC |
4 | (deflayer omit-nil-attributes) |
5 | ||
6 | (defdisplay :in-layer omit-nil-attributes | |
7 | :around ((attribute standard-attribute) object) | |
8 | (when (attribute-value object attribute) | |
9 | (call-next-method))) | |
10 | ||
e1645f63 | 11 | (deflayer show-attribute-labels) |
2b0fd9c8 | 12 | |
e1645f63 | 13 | (defdisplay |
14 | :in-layer show-attribute-labels | |
e4f96295 | 15 | :around ((attribute standard-attribute) object) |
e1645f63 | 16 | (<:span |
17 | :class "lol-label" | |
18 | (<:as-html (or (label attribute) (attribute.name attribute)) " ")) | |
19 | (<:span | |
20 | :class "lol-attribute" | |
21 | (call-next-method))) | |
22 | ||
23 | (deflayer use-pretty-labels) | |
24 | ||
25 | (define-layered-method label | |
26 | :in-layer use-pretty-labels | |
27 | :around (standard-attribute) | |
28 | (let ((label (call-next-method))) | |
29 | (when label | |
30 | (string-capitalize | |
31 | (substitute #\Space #\- label))))) | |
32 | ||
e4f96295 | 33 | (deflayer inspect-attributes) |
34 | ||
35 | (defdisplay :in-layer inspect-attributes | |
36 | :around ((attribute standard-attribute) object) | |
37 | (call-next-method) | |
38 | (<ucw:a :action (ucw::call-inspector self attribute) | |
39 | :title | |
40 | (strcat "Inspect " | |
41 | (attribute.name attribute) ":" | |
42 | (description.type attribute) ":" | |
43 | (type-of attribute)) | |
44 | (<:as-html "(i)"))) | |
45 | ||
46 | ;;;; Functional attributes | |
47 | (defattribute display-attribute () | |
48 | ((display-arguments | |
49 | :accessor display-arguments | |
50 | :initarg :display | |
51 | :special t | |
52 | :initform nil)) | |
53 | (:type-name display) | |
e1645f63 | 54 | (:documentation "Apply the display function to this object")) |
2b0fd9c8 | 55 | |
e4f96295 | 56 | (defdisplay ((attribute display-attribute) object) |
e1645f63 | 57 | (apply #'display self (attribute-value object attribute) |
e4f96295 | 58 | (display-arguments attribute))) |
2b0fd9c8 | 59 | |
e4f96295 | 60 | (defattribute function-attribute () |
61 | ((function :accessor function-of | |
62 | :initarg :function | |
63 | :initform #'funcall | |
64 | :special t)) | |
65 | (:type-name function) | |
66 | (:documentation "")) | |
2b0fd9c8 | 67 | |
e4f96295 | 68 | (defdisplay ((function function-attribute) object) |
69 | (funcall (function-of function) | |
70 | (attribute-value object function))) | |
2b0fd9c8 | 71 | |
2b0fd9c8 | 72 | |
e4f96295 | 73 | ;;;; Attribute Grouping |
74 | (defattribute attribute-group () | |
9af22ce3 | 75 | () |
a4e6154d | 76 | (:default-properties |
e4f96295 | 77 | :group nil) |
78 | (:type-name group)) | |
e1645f63 | 79 | |
e4f96295 | 80 | (defdisplay ((group attribute-group) object) |
81 | (apply #'display self object | |
82 | :attributes (attributes group) | |
83 | (group group))) | |
e1645f63 | 84 | |
e4f96295 | 85 | ;;;; * Base Types |
e1645f63 | 86 | |
e4f96295 | 87 | (defattribute base-attribute () |
88 | () | |
89 | (:default-properties | |
90 | :default-value "")) | |
e1645f63 | 91 | |
e4f96295 | 92 | (defdisplay ((base base-attribute) object) |
93 | (<:as-html (attribute-value object base))) | |
e1645f63 | 94 | |
e4f96295 | 95 | (defattribute base-attribute (ucw::string-field) |
96 | () | |
97 | (:in-layer editor) | |
98 | (:default-properties | |
99 | :callback nil | |
100 | :default-value nil | |
101 | :default-value-predicate #'null)) | |
e1645f63 | 102 | |
e4f96295 | 103 | (define-layered-function display-value (attribute value) |
104 | (:method (attribute value) | |
105 | (if (funcall (default-value-predicate attribute) value) | |
106 | (default-value attribute) | |
107 | value))) | |
e1645f63 | 108 | |
109 | (defdisplay | |
e4f96295 | 110 | :in-layer editor ((field base-attribute) object) |
111 | (LET ((value (attribute-value (object field) field))) | |
112 | (<:input | |
113 | :NAME | |
114 | (callback field) | |
115 | :VALUE (escape-as-html (strcat (display-value field value))) | |
116 | :TYPE | |
117 | "text" | |
118 | :ID | |
119 | (DOM-ID FIELD) | |
120 | :SIZE | |
121 | (ucw::INPUT-SIZE FIELD)))) | |
e1645f63 | 122 | |
a4e6154d DC |
123 | (defdisplay |
124 | :in-layer editor :around ((string base-attribute) object) | |
e4f96295 | 125 | (dletf (((callback string) |
126 | (or (callback string) | |
127 | (ucw::make-new-callback | |
128 | #'(lambda (val) | |
129 | (setf (attribute-value object string) val))))) | |
e1645f63 | 130 | ((object string) object)) |
a4e6154d | 131 | (call-next-method))) |
2b0fd9c8 | 132 | |
a4e6154d DC |
133 | ;;;; Strings |
134 | ||
e1645f63 | 135 | (defattribute string-attribute (base-attribute) |
a4e6154d | 136 | () |
9af22ce3 DC |
137 | (:type-name string) |
138 | (:default-properties | |
2b0fd9c8 DC |
139 | :escape-html-p t |
140 | :size nil | |
e4f96295 | 141 | :max-length nil |
142 | :default-value "")) | |
9af22ce3 | 143 | |
2b0fd9c8 DC |
144 | (defdisplay :in-layer omit-nil-attributes |
145 | :around ((attribute string-attribute) object) | |
146 | (when (< 0 (length (attribute-value object attribute))) | |
147 | (call-next-method))) | |
148 | ||
2b0fd9c8 | 149 | ;;;; default |
a4e6154d DC |
150 | (defdisplay :in-layer viewer |
151 | ((string string-attribute) object) | |
2b0fd9c8 | 152 | (if (escape-html-p string) |
9af22ce3 DC |
153 | (<:as-html (attribute-value object string)) |
154 | (<:as-is (attribute-value object string)))) | |
155 | ||
156 | ||
2b0fd9c8 DC |
157 | ;;;; editor |
158 | (defattribute string-attribute (base-attribute) | |
159 | () | |
160 | (:in-layer editor) | |
161 | (:default-properties | |
162 | :callback nil)) | |
163 | ||
a4e6154d | 164 | |
2b0fd9c8 DC |
165 | (defattribute string-search-attribute (string-attribute) |
166 | () | |
167 | (:default-properties | |
168 | ;; the func that find search results | |
169 | ||
170 | :search-action #'(lambda () | |
171 | (with-call/cc | |
172 | nil)) | |
173 | ;; when chosing from a list of results, this function selects one. | |
174 | :select-function (constantly t)) | |
175 | (:type-name string-search)) | |
176 | ||
177 | (defdisplay | |
178 | :in-layer editor :after ((search string-search-attribute) object) | |
a4e6154d DC |
179 | (<:input |
180 | :TYPE "submit" | |
181 | :VALUE "search" | |
182 | :ONCLICK | |
183 | (JS:JS-INLINE* | |
184 | `(PROGN | |
185 | (IT.BESE.UCW::SET-ACTION-PARAMETER | |
186 | ,(IT.BESE.UCW::MAKE-NEW-ACTION | |
187 | (IT.BESE.UCW::CONTEXT.CURRENT-FRAME *CONTEXT*) | |
188 | (search-action search))) | |
189 | (RETURN T))))) | |
2b0fd9c8 DC |
190 | |
191 | ;;;; textarea | |
192 | ||
193 | (defattribute text-attribute (string-attribute) | |
a4e6154d DC |
194 | () |
195 | (:type-name text)) | |
2b0fd9c8 DC |
196 | |
197 | (defdisplay :in-layer editor ((string text-attribute) object) | |
198 | (<:textarea | |
e4f96295 | 199 | :id (dom-id string) |
2b0fd9c8 | 200 | :name (callback string) |
a4e6154d | 201 | (or (attribute-value object string) ""))) |
2b0fd9c8 DC |
202 | |
203 | ||
204 | ||
205 | ;;;; WALL-TIME | |
206 | ||
207 | (defattribute wall-time-attribute (string-attribute) | |
208 | () | |
209 | (:type-name clsql-sys:wall-time)) | |
210 | ||
211 | (define-layered-method attribute-value (object (attribute wall-time-attribute)) | |
212 | (let ((date (call-next-method))) | |
213 | (when date (multiple-value-bind (y m d) (clsql:time-ymd date) | |
214 | (format nil "~a/~a/~a" m d y))))) | |
215 | ||
216 | (defdisplay | |
217 | ((time wall-time-attribute) object) | |
218 | (<:as-html (attribute-value object time))) | |
219 | ||
220 | ||
221 | ||
7733a777 | 222 | (defattribute image () |
a4e6154d DC |
223 | () |
224 | (:default-properties | |
225 | :css-class "lol-image" | |
226 | :prefix "images/")) | |
7733a777 | 227 | |
2b0fd9c8 | 228 | (defdisplay ((buttons (eql 'image-editor-buttons)) object) |
60a24293 DC |
229 | (<ucw:a :action (ok component object) |
230 | (<:as-html "select this image"))) | |
231 | ||
2b0fd9c8 | 232 | (defdisplay ((image image) object) |
7733a777 | 233 | (<:img |
a4e6154d | 234 | :class (or (css-class image) "lol-image") |
7733a777 | 235 | :src (arnesi:strcat |
a4e6154d | 236 | (or (prefix image) "images/") |
7733a777 DC |
237 | (escape-as-uri |
238 | (attribute-value object image))))) | |
239 | ||
2b0fd9c8 DC |
240 | (defdisplay |
241 | :in-layer editor ((image image) object) | |
242 | ||
60a24293 | 243 | (<:div |
2b0fd9c8 | 244 | :class "lol-image-thumbnails" |
a4e6154d | 245 | (<:as-html "imagie"))) |
60a24293 | 246 | |
7733a777 DC |
247 | |
248 | ||
249 | ||
250 | ||
251 |