Major patch touching a lot, representing the new lol. is mostly drop-in backwards...
[clinton/lisp-on-lines.git] / src / components / dojo.lisp
CommitLineData
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 )