Commit | Line | Data |
---|---|---|
41af2f6d DC |
1 | (in-package :lol) |
2 | ||
3 | ||
4 | ;;;; * Dojo Javascript Components | |
5 | (defcomponent dojo-component () | |
6 | ((requires :accessor requires :initarg :requires :initform nil))) | |
7 | ||
8 | (defmethod render-requires ((self dojo-component)) | |
9 | (<ucw:script `(progn ,@(loop for r in (requires self) | |
10 | collect `(dojo.require ,r))))) | |
11 | ||
12 | (defmethod render :wrapping ( (self dojo-component)) | |
13 | (render-requires self) | |
14 | (call-next-method)) | |
15 | ||
16 | (defmethod lol::present :around ((self dojo-component)) | |
17 | (render-requires self) | |
18 | (call-next-method)) | |
19 | ||
20 | (defcomponent dojo-ajax-output-component (window-component) | |
21 | ((component :accessor component :initarg :component :component dojo-component))) | |
22 | ||
23 | (defmethod render ((self dojo-ajax-output-component)) | |
24 | (lol::present self)) | |
25 | ||
26 | (defmethod lol::present ((self dojo-ajax-output-component)) | |
27 | (present-output (component self))) | |
28 | ||
29 | (defcomponent dojo-input-component-mixin () | |
30 | ((input-id | |
31 | :accessor input-id | |
32 | :initform (arnesi:random-string 32 arnesi::+ALPHANUMERIC-ASCII-ALPHABET+)))) | |
33 | ||
34 | (defcomponent dojo-output-component-mixin () | |
35 | ((output-id | |
36 | :accessor output-id | |
37 | :initform (arnesi:random-string 32 arnesi::+ALPHANUMERIC-ASCII-ALPHABET+)) | |
38 | (output-component | |
39 | :accessor output-component | |
40 | :component dojo-ajax-output-component))) | |
41 | ||
42 | (defmethod shared-initialize :after ((self dojo-output-component-mixin) slots &rest args) | |
43 | (declare (ignore slots args)) | |
44 | (setf (component (output-component self)) self)) | |
45 | ||
46 | ||
47 | (defmacro with-ajax ((component) &body args) | |
48 | (multiple-value-bind (actions callbacks args output) | |
49 | (loop for arg in args | |
50 | if (eql (car arg) :action) | |
51 | nconc (cdr arg) into actions | |
52 | else if (eql (car arg) :callback) | |
53 | collect (cdr arg) into callbacks | |
54 | else if (eql (car arg) :output-to) | |
55 | nconc (cdr arg) into output | |
56 | else | |
57 | nconc arg into args | |
58 | finally (return (values actions callbacks args output))) | |
59 | `(js:with-unique-js-names (js-callbacks) | |
60 | `(progn | |
61 | (setf ,js-callbacks (array)) | |
62 | ,,@(loop for c in callbacks | |
63 | for i upfrom 0 | |
64 | collect | |
65 | ``(setf (aref ,js-callbacks ,,i) | |
66 | (lambda () ,,(third c)))) | |
67 | (dojo.io.bind | |
68 | (create | |
69 | ,@(unless | |
70 | ,(getf args :url) | |
71 | `(:url | |
72 | ,(lol::make-action-url | |
73 | ,component | |
74 | (progn | |
2b0fd9c8 | 75 | ,@actions)))) |
41af2f6d DC |
76 | ,@ (unless |
77 | ,(getf args :post-content) | |
78 | `(:post-content (+ ,,@(loop for c in callbacks | |
79 | for n upfrom 0 | |
80 | nconc `((ucw::make-new-callback | |
81 | ||
82 | (lambda (,(car c)) | |
83 | ,(second c))) | |
84 | "=" | |
85 | `(encode-u-r-i-component ((aref ,js-callbacks ,,n))) | |
86 | "&"))))) | |
87 | ,@ (unless | |
88 | ,(or (getf args :load) (not output) ) | |
89 | `(:load | |
90 | (lambda (evt data) | |
91 | (setf (slot-value (document.get-element-by-id ,,@output) inner-h-t-m-l) data)))) | |
92 | ,,:method "post" | |
93 | ,,@args)))))) | |
94 | ||
95 | ||
96 | ||
97 | ||
98 | ||
99 | ;;;; ** Editor | |
100 | ||
101 | (defcomponent dojo-editor (dojo-component dojo-input-component-mixin) | |
102 | ((document :accessor document :initarg :document :initform "test")) | |
103 | (:default-initargs | |
104 | :requires '("dojo.event.*" "dojo.widget.Editor" "dojo.io.*" "dojo.widget.RichText"))) | |
105 | ||
106 | (defmethod save-document ((self dojo-editor)) | |
107 | t) | |
108 | ||
109 | (defmethod js-on-load ((self dojo-editor)) | |
110 | `(lambda (x) | |
111 | (setf document.location | |
112 | ,(lol::make-action-url | |
113 | self | |
114 | (answer self))))) | |
115 | ||
116 | (defmethod render-editor ((self dojo-editor)) | |
117 | (<ucw:script | |
118 | `(dojo.add-on-load | |
119 | (lambda () | |
120 | (setf div (document.get-element-by-id ,(input-id self))) | |
121 | (setf editor (dojo.widget.from-script | |
122 | "Editor" | |
123 | (create) div)) | |
124 | (setf save | |
125 | (create | |
126 | :save-to-server | |
127 | (lambda () | |
128 | (dojo.io.bind | |
129 | (create | |
130 | :method "post" | |
131 | :post-content (+ | |
132 | ,(ucw::make-new-callback | |
133 | ||
134 | (lambda (x) | |
135 | (setf (document self) x))) | |
136 | "=" | |
137 | (encode-u-r-i-component (editor.get-html))) | |
138 | :url | |
139 | ,(lol::make-action-url | |
140 | self | |
141 | (save-document self)) | |
142 | ||
143 | :load ,(js-on-load self)))))) | |
144 | (dojo.event.kw-connect | |
145 | (create :type "before" | |
146 | :src-obj editor | |
147 | :src-func "onSave" | |
148 | :target-obj save | |
149 | :target-func "saveToServer"))))) | |
150 | (<:div :class "editor" | |
151 | (<:div | |
152 | :id (input-id self) | |
153 | (<:as-is (document self))))) | |
154 | ||
155 | (defmethod render ((self dojo-editor)) | |
156 | (render-editor self)) | |
157 | ||
158 | (defcomponent dojo-editor-presentation (dojo-editor mewa::mewa-editor) | |
159 | ()) | |
160 | ||
161 | (lol::defslot-presentation dojo-editor-slot-presentation (dojo-editor mewa::mewa-string-slot-presentation) | |
162 | ((document :accessor document :initarg :document) | |
163 | (instance :accessor instance)) | |
164 | (:type-name dojo-editor)) | |
165 | ||
166 | (defmethod save-document ((self dojo-editor-slot-presentation)) | |
167 | (setf (lol::presentation-slot-value self (instance self)) (document self))) | |
168 | ||
169 | (defmethod lol::present-slot ((slot dojo-editor-slot-presentation) instance) | |
170 | (setf (document slot) (lol::presentation-slot-value slot instance)) | |
171 | (setf (instance slot) instance) | |
172 | (render-requires slot) | |
173 | (render-editor slot)) | |
174 | ||
175 | (defmethod js-on-load ((self dojo-editor-slot-presentation)) | |
176 | `(lambda (x) | |
177 | (setf document.location | |
178 | ,(lol::make-action-url | |
179 | self | |
180 | (answer-component (ucw::parent self) self))))) | |
181 | ||
182 | ||
183 | (defcomponent sortable-list-editor (lol::mewa-list-presentation | |
184 | dojo-component | |
185 | dojo-input-component-mixin | |
186 | dojo-output-component-mixin) | |
187 | () | |
188 | (:default-initargs | |
189 | :requires '("dojo.event.*" "dojo.dnd.*" "dojo.io.*"))) | |
190 | ||
191 | (defmethod present-output ((self sortable-list-editor)) | |
192 | (loop for li in (mewa::instances self) | |
193 | for n upfrom 0 | |
194 | do | |
195 | (let ((li li)) | |
196 | (<:li :id (format nil "~A~A" (input-id self) n) | |
197 | (<:as-html (lol:present-view (li :one-line))) | |
198 | (<:br) | |
199 | (<ucw:a :action (lol:call-view (li :editor (call-from self))) | |
200 | (<:as-html "(edit)")) | |
201 | (<ucw:a :action (lol:call-view (li :editor)) | |
202 | (<:as-html "(remove)")))))) | |
203 | ||
204 | (defmethod lol::present ((self sortable-list-editor)) | |
205 | (<:div (<:as-html "Drag and Drop list items to change the order")) | |
206 | (<:ul | |
207 | :id (input-id self) | |
208 | (present-output self)) | |
209 | (<:ul (<:li | |
210 | (<ucw:a :action (answer (mewa::instances self)) | |
211 | (<:as-html "*Save*"))) | |
212 | ||
213 | (<:li | |
214 | (<ucw:a :action (add-list-item self) | |
215 | (<:as-html "*Add Item*"))) | |
216 | (<:li | |
217 | (<ucw:a :action (answer nil) | |
218 | (<:as-html "*Cancel*")))) | |
219 | ||
220 | (<ucw:script | |
221 | ;;;; The Dojo example : | |
222 | ;;;; var dl = byId("dragList3"); | |
223 | ;;;; new dojo.dnd.HtmlDropTarget(dl, ["li2"]); | |
224 | ;;;; var lis = dl.getElementsByTagName("li"); | |
225 | ;;;; for(var x=0; x<lis.length; x++){ | |
226 | ;;;; new dojo.dnd.HtmlDragSource(lis[x], "li2");} | |
227 | ||
228 | ;;;; and the parenscript | |
229 | `(dojo.event.connect dojo "loaded" | |
230 | (lambda () | |
231 | (setf make-sortable | |
232 | (lambda (x) | |
233 | (setf ulist (document.get-element-by-id x)) | |
234 | (setf drop (new (dojo.dnd.*html-drop-target ulist (array x)))) | |
235 | (setf list-items (ulist.get-elements-by-tag-name "li" )) | |
236 | (dolist (li list-items) | |
237 | (new (dojo.dnd.*html-drag-source li x))))) | |
238 | (make-sortable ,(input-id self)) | |
239 | ||
240 | (dojo.event.connect | |
241 | drop "onDrop" | |
242 | (lambda () | |
243 | (dolist (li list-items) | |
244 | (new (dojo.dnd.*html-drag-source li ,(input-id self)))) | |
245 | , | |
246 | (with-ajax (self) | |
247 | (:action nil) | |
248 | (:callback d (let ((list-order | |
249 | (mapcar #'(lambda (x) | |
250 | (parse-integer (subseq x (length (input-id self))))) | |
251 | (read-from-string d)))) | |
252 | (setf (mewa::instances self) (reorder-list (mewa::instances self) list-order))) | |
253 | `(progn | |
254 | (setf my-list "(") | |
255 | (dolist (li list-items) | |
256 | (setf my-list (+ my-list "\"" li.id "\"" " "))) | |
257 | (setf my-list (+ my-list ")")) | |
258 | (return my-list))) | |
259 | (:load `(lambda (x data) | |
260 | (setf (slot-value (document.get-element-by-id ,(input-id self)) inner-h-t-m-l) data) | |
261 | (make-sortable ,(input-id self))))))))))) | |
262 | ||
263 | ||
264 | ;(defcomponent dojo-combo-box ) |