| 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 |
| 75 | ,@actions)))) |
| 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 ) |