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 | |
15 | :around ((attribute standard-attribute) object) | |
16 | ||
17 | (<:span | |
18 | :class "lol-label" | |
19 | (<:as-html (or (label attribute) (attribute.name attribute)) " ")) | |
20 | (<:span | |
21 | :class "lol-attribute" | |
22 | (call-next-method))) | |
23 | ||
24 | (deflayer use-pretty-labels) | |
25 | ||
26 | (define-layered-method label | |
27 | :in-layer use-pretty-labels | |
28 | :around (standard-attribute) | |
29 | (let ((label (call-next-method))) | |
30 | (when label | |
31 | (string-capitalize | |
32 | (substitute #\Space #\- label))))) | |
33 | ||
34 | (defattribute display () | |
35 | () | |
36 | (:documentation "Apply the display function to this object")) | |
2b0fd9c8 | 37 | |
e1645f63 | 38 | (defdisplay ((attribute display) object) |
39 | (apply #'display self (attribute-value object attribute) | |
40 | (description.properties attribute))) | |
2b0fd9c8 DC |
41 | |
42 | ;;;; * Base Types | |
43 | ||
44 | (defattribute base-attribute () | |
45 | ()) | |
46 | ||
47 | (defdisplay ((base base-attribute) object) | |
48 | (<:as-html (attribute-value object base))) | |
49 | ||
e1645f63 | 50 | (defattribute base-attribute (ucw::string-field) |
9af22ce3 | 51 | () |
a4e6154d DC |
52 | (:in-layer editor) |
53 | (:default-properties | |
54 | :callback nil)) | |
55 | ||
e1645f63 | 56 | (defmethod ucw:client-value ((self base-attribute)) |
57 | (attribute-value (object self) self)) | |
58 | ||
59 | (defmethod (setf ucw:client-value) (value (attribute base-attribute)) | |
60 | (setf (attribute-value (object attribute) attribute) value)) | |
61 | ||
62 | ||
63 | (defmethod render ((field base-attribute)) | |
64 | "this can only be used within a display-using-description call in the editor context, | |
65 | it is a hack to integrate lol with ucw's new form stuff" | |
66 | (call-next-method)) | |
67 | ||
68 | #+ (or) | |
69 | (LET ((value (attribute-value (object field) field))) | |
70 | (<:as-html "asd" value) | |
71 | (<:input | |
72 | :NAME | |
73 | (callback field) | |
74 | :VALUE (escape-as-html value) | |
75 | :TYPE | |
76 | "text" | |
77 | :ID | |
78 | (DOM-ID FIELD) | |
79 | :SIZE | |
80 | (ucw::INPUT-SIZE FIELD))) | |
81 | ||
82 | ||
83 | ||
84 | (defdisplay | |
85 | :in-layer editor ((string base-attribute) object) | |
86 | (render string)) | |
87 | ||
88 | ||
a4e6154d DC |
89 | (defdisplay |
90 | :in-layer editor :around ((string base-attribute) object) | |
91 | (dletf (((callback string) (ucw::make-new-callback | |
92 | #'(lambda (val) | |
e1645f63 | 93 | (setf (attribute-value object string) val)))) |
94 | ((object string) object)) | |
a4e6154d | 95 | (call-next-method))) |
2b0fd9c8 | 96 | |
a4e6154d DC |
97 | ;;;; Strings |
98 | ||
e1645f63 | 99 | (defattribute string-attribute (base-attribute) |
a4e6154d | 100 | () |
9af22ce3 DC |
101 | (:type-name string) |
102 | (:default-properties | |
2b0fd9c8 DC |
103 | :escape-html-p t |
104 | :size nil | |
105 | :max-length nil)) | |
9af22ce3 | 106 | |
2b0fd9c8 DC |
107 | (defdisplay :in-layer omit-nil-attributes |
108 | :around ((attribute string-attribute) object) | |
109 | (when (< 0 (length (attribute-value object attribute))) | |
110 | (call-next-method))) | |
111 | ||
2b0fd9c8 | 112 | ;;;; default |
a4e6154d DC |
113 | (defdisplay :in-layer viewer |
114 | ((string string-attribute) object) | |
2b0fd9c8 | 115 | (if (escape-html-p string) |
9af22ce3 DC |
116 | (<:as-html (attribute-value object string)) |
117 | (<:as-is (attribute-value object string)))) | |
118 | ||
119 | ||
2b0fd9c8 DC |
120 | ;;;; editor |
121 | (defattribute string-attribute (base-attribute) | |
122 | () | |
123 | (:in-layer editor) | |
124 | (:default-properties | |
125 | :callback nil)) | |
126 | ||
a4e6154d | 127 | |
2b0fd9c8 DC |
128 | (defattribute string-search-attribute (string-attribute) |
129 | () | |
130 | (:default-properties | |
131 | ;; the func that find search results | |
132 | ||
133 | :search-action #'(lambda () | |
134 | (with-call/cc | |
135 | nil)) | |
136 | ;; when chosing from a list of results, this function selects one. | |
137 | :select-function (constantly t)) | |
138 | (:type-name string-search)) | |
139 | ||
140 | (defdisplay | |
141 | :in-layer editor :after ((search string-search-attribute) object) | |
a4e6154d DC |
142 | (<:input |
143 | :TYPE "submit" | |
144 | :VALUE "search" | |
145 | :ONCLICK | |
146 | (JS:JS-INLINE* | |
147 | `(PROGN | |
148 | (IT.BESE.UCW::SET-ACTION-PARAMETER | |
149 | ,(IT.BESE.UCW::MAKE-NEW-ACTION | |
150 | (IT.BESE.UCW::CONTEXT.CURRENT-FRAME *CONTEXT*) | |
151 | (search-action search))) | |
152 | (RETURN T))))) | |
2b0fd9c8 DC |
153 | |
154 | ;;;; textarea | |
155 | ||
156 | (defattribute text-attribute (string-attribute) | |
a4e6154d DC |
157 | () |
158 | (:type-name text)) | |
2b0fd9c8 DC |
159 | |
160 | (defdisplay :in-layer editor ((string text-attribute) object) | |
161 | (<:textarea | |
162 | :id (id string) | |
163 | :name (callback string) | |
a4e6154d | 164 | (or (attribute-value object string) ""))) |
2b0fd9c8 DC |
165 | |
166 | ||
167 | ||
168 | ;;;; WALL-TIME | |
169 | ||
170 | (defattribute wall-time-attribute (string-attribute) | |
171 | () | |
172 | (:type-name clsql-sys:wall-time)) | |
173 | ||
174 | (define-layered-method attribute-value (object (attribute wall-time-attribute)) | |
175 | (let ((date (call-next-method))) | |
176 | (when date (multiple-value-bind (y m d) (clsql:time-ymd date) | |
177 | (format nil "~a/~a/~a" m d y))))) | |
178 | ||
179 | (defdisplay | |
180 | ((time wall-time-attribute) object) | |
181 | (<:as-html (attribute-value object time))) | |
182 | ||
183 | ||
184 | ||
7733a777 | 185 | (defattribute image () |
a4e6154d DC |
186 | () |
187 | (:default-properties | |
188 | :css-class "lol-image" | |
189 | :prefix "images/")) | |
7733a777 | 190 | |
2b0fd9c8 | 191 | (defdisplay ((buttons (eql 'image-editor-buttons)) object) |
60a24293 DC |
192 | (<ucw:a :action (ok component object) |
193 | (<:as-html "select this image"))) | |
194 | ||
2b0fd9c8 | 195 | (defdisplay ((image image) object) |
7733a777 | 196 | (<:img |
a4e6154d | 197 | :class (or (css-class image) "lol-image") |
7733a777 | 198 | :src (arnesi:strcat |
a4e6154d | 199 | (or (prefix image) "images/") |
7733a777 DC |
200 | (escape-as-uri |
201 | (attribute-value object image))))) | |
202 | ||
2b0fd9c8 DC |
203 | (defdisplay |
204 | :in-layer editor ((image image) object) | |
205 | ||
60a24293 | 206 | (<:div |
2b0fd9c8 | 207 | :class "lol-image-thumbnails" |
a4e6154d | 208 | (<:as-html "imagie"))) |
60a24293 | 209 | |
7733a777 DC |
210 | |
211 | ||
212 | ||
213 | ||
214 |