Commit | Line | Data |
---|---|---|
7733a777 DC |
1 | (in-package :lisp-on-lines) |
2 | ||
2b0fd9c8 DC |
3 | (deflayer omit-nil-attributes) |
4 | ||
5 | (defdisplay :in-layer omit-nil-attributes | |
6 | :around ((attribute standard-attribute) object) | |
7 | (when (attribute-value object attribute) | |
8 | (call-next-method))) | |
9 | ||
10 | (deflayer label-attributes) | |
11 | ||
12 | (defdisplay :in-layer label-attributes | |
13 | :around ((attribute standard-attribute) object) | |
14 | ||
15 | (<:span | |
16 | :class "lol-label" | |
17 | (<:as-html (or (label attribute) (attribute.name attribute)))) | |
18 | (<:span | |
19 | :class "lol-attribute" | |
20 | (call-next-method))) | |
21 | ||
22 | ;;;; * Base Types | |
23 | ||
24 | (defattribute base-attribute () | |
25 | ()) | |
26 | ||
27 | (defdisplay ((base base-attribute) object) | |
28 | (<:as-html (attribute-value object base))) | |
29 | ||
9af22ce3 | 30 | |
a4e6154d | 31 | (defattribute base-attribute () |
9af22ce3 | 32 | () |
a4e6154d DC |
33 | (:in-layer editor) |
34 | (:default-properties | |
35 | :callback nil)) | |
36 | ||
37 | (defdisplay | |
38 | :in-layer editor :around ((string base-attribute) object) | |
39 | (dletf (((callback string) (ucw::make-new-callback | |
40 | #'(lambda (val) | |
41 | (setf (attribute-value object string) val))))) | |
42 | (call-next-method))) | |
2b0fd9c8 | 43 | |
a4e6154d DC |
44 | ;;;; Strings |
45 | ||
46 | (defattribute string-attribute () | |
47 | () | |
9af22ce3 DC |
48 | (:type-name string) |
49 | (:default-properties | |
2b0fd9c8 DC |
50 | :escape-html-p t |
51 | :size nil | |
52 | :max-length nil)) | |
9af22ce3 | 53 | |
a4e6154d DC |
54 | (defdisplay |
55 | :in-layer editor ((string base-attribute) object) | |
56 | (<:input | |
57 | :type "text" | |
58 | :id (id string) | |
59 | :name (callback string) | |
60 | :value (or (attribute-value object string) ""))) | |
61 | ||
62 | ||
2b0fd9c8 DC |
63 | (defdisplay :in-layer omit-nil-attributes |
64 | :around ((attribute string-attribute) object) | |
65 | (when (< 0 (length (attribute-value object attribute))) | |
66 | (call-next-method))) | |
67 | ||
2b0fd9c8 | 68 | ;;;; default |
a4e6154d DC |
69 | (defdisplay :in-layer viewer |
70 | ((string string-attribute) object) | |
2b0fd9c8 | 71 | (if (escape-html-p string) |
9af22ce3 DC |
72 | (<:as-html (attribute-value object string)) |
73 | (<:as-is (attribute-value object string)))) | |
74 | ||
75 | ||
2b0fd9c8 DC |
76 | ;;;; editor |
77 | (defattribute string-attribute (base-attribute) | |
78 | () | |
79 | (:in-layer editor) | |
80 | (:default-properties | |
81 | :callback nil)) | |
82 | ||
a4e6154d | 83 | |
2b0fd9c8 DC |
84 | (defattribute string-search-attribute (string-attribute) |
85 | () | |
86 | (:default-properties | |
87 | ;; the func that find search results | |
88 | ||
89 | :search-action #'(lambda () | |
90 | (with-call/cc | |
91 | nil)) | |
92 | ;; when chosing from a list of results, this function selects one. | |
93 | :select-function (constantly t)) | |
94 | (:type-name string-search)) | |
95 | ||
96 | (defdisplay | |
97 | :in-layer editor :after ((search string-search-attribute) object) | |
a4e6154d DC |
98 | (<:input |
99 | :TYPE "submit" | |
100 | :VALUE "search" | |
101 | :ONCLICK | |
102 | (JS:JS-INLINE* | |
103 | `(PROGN | |
104 | (IT.BESE.UCW::SET-ACTION-PARAMETER | |
105 | ,(IT.BESE.UCW::MAKE-NEW-ACTION | |
106 | (IT.BESE.UCW::CONTEXT.CURRENT-FRAME *CONTEXT*) | |
107 | (search-action search))) | |
108 | (RETURN T))))) | |
2b0fd9c8 DC |
109 | |
110 | ;;;; textarea | |
111 | ||
112 | (defattribute text-attribute (string-attribute) | |
a4e6154d DC |
113 | () |
114 | (:type-name text)) | |
2b0fd9c8 DC |
115 | |
116 | (defdisplay :in-layer editor ((string text-attribute) object) | |
117 | (<:textarea | |
118 | :id (id string) | |
119 | :name (callback string) | |
a4e6154d | 120 | (or (attribute-value object string) ""))) |
2b0fd9c8 DC |
121 | |
122 | ||
123 | ||
124 | ;;;; WALL-TIME | |
125 | ||
126 | (defattribute wall-time-attribute (string-attribute) | |
127 | () | |
128 | (:type-name clsql-sys:wall-time)) | |
129 | ||
130 | (define-layered-method attribute-value (object (attribute wall-time-attribute)) | |
131 | (let ((date (call-next-method))) | |
132 | (when date (multiple-value-bind (y m d) (clsql:time-ymd date) | |
133 | (format nil "~a/~a/~a" m d y))))) | |
134 | ||
135 | (defdisplay | |
136 | ((time wall-time-attribute) object) | |
137 | (<:as-html (attribute-value object time))) | |
138 | ||
139 | ||
140 | ||
7733a777 | 141 | (defattribute image () |
a4e6154d DC |
142 | () |
143 | (:default-properties | |
144 | :css-class "lol-image" | |
145 | :prefix "images/")) | |
7733a777 | 146 | |
2b0fd9c8 | 147 | (defdisplay ((buttons (eql 'image-editor-buttons)) object) |
60a24293 DC |
148 | (<ucw:a :action (ok component object) |
149 | (<:as-html "select this image"))) | |
150 | ||
2b0fd9c8 | 151 | (defdisplay ((image image) object) |
7733a777 | 152 | (<:img |
a4e6154d | 153 | :class (or (css-class image) "lol-image") |
7733a777 | 154 | :src (arnesi:strcat |
a4e6154d | 155 | (or (prefix image) "images/") |
7733a777 DC |
156 | (escape-as-uri |
157 | (attribute-value object image))))) | |
158 | ||
2b0fd9c8 DC |
159 | (defdisplay |
160 | :in-layer editor ((image image) object) | |
161 | ||
60a24293 | 162 | (<:div |
2b0fd9c8 | 163 | :class "lol-image-thumbnails" |
a4e6154d | 164 | (<:as-html "imagie"))) |
60a24293 | 165 | |
7733a777 DC |
166 | |
167 | ||
168 | ||
169 | ||
170 |