src/components/dojo.lisp

   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                           (call-component nil (output-component self))))))
  77                  ,@ (unless
  78                         ,(getf args :post-content)
  79                       `(:post-content (+ ,,@(loop for c in callbacks
  80                                                   for n upfrom 0
  81                                                   nconc `((ucw::make-new-callback
  82
  83                                                            (lambda (,(car c))
  84                                                              ,(second c)))
  85                                                           "="
  86                                                           `(encode-u-r-i-component ((aref ,js-callbacks ,,n)))
  87                                                           "&")))))
  88                  ,@ (unless
  89                         ,(or (getf args :load) (not output) )
  90                       `(:load
  91                         (lambda (evt data)
  92                           (setf (slot-value (document.get-element-by-id ,,@output) inner-h-t-m-l) data))))
  93                  ,,:method "post"
  94                  ,,@args))))))
  95
  96
  97
  98
  99
 100 ;;;; ** Editor
 101
 102 (defcomponent dojo-editor (dojo-component dojo-input-component-mixin)
 103   ((document :accessor document :initarg :document :initform "test"))
 104   (:default-initargs
 105       :requires '("dojo.event.*" "dojo.widget.Editor" "dojo.io.*" "dojo.widget.RichText")))
 106
 107 (defmethod save-document ((self dojo-editor))
 108   t)
 109
 110 (defmethod js-on-load ((self dojo-editor))
 111   `(lambda (x)
 112     (setf document.location
 113           ,(lol::make-action-url
 114             self
 115             (answer self)))))
 116
 117 (defmethod render-editor ((self dojo-editor))
 118   (<ucw:script
 119    `(dojo.add-on-load
 120      (lambda ()
 121        (setf div (document.get-element-by-id ,(input-id self)))
 122        (setf editor (dojo.widget.from-script
 123                      "Editor"
 124                      (create) div))
 125        (setf save
 126              (create
 127               :save-to-server
 128               (lambda ()
 129                 (dojo.io.bind
 130                  (create
 131                   :method "post"
 132                   :post-content (+
 133                                  ,(ucw::make-new-callback
 134
 135                                    (lambda (x)
 136                                      (setf (document self) x)))
 137                                  "="
 138                                  (encode-u-r-i-component (editor.get-html)))
 139                   :url
 140                   ,(lol::make-action-url
 141                     self
 142                     (save-document self))
 143
 144                   :load ,(js-on-load self))))))
 145        (dojo.event.kw-connect
 146         (create :type "before"
 147                 :src-obj editor
 148                 :src-func "onSave"
 149                 :target-obj save
 150                 :target-func "saveToServer")))))
 151   (<:div :class "editor"
 152          (<:div
 153    :id (input-id self)
 154    (<:as-is (document self)))))
 155
 156 (defmethod render ((self dojo-editor))
 157   (render-editor self))
 158
 159 (defcomponent dojo-editor-presentation (dojo-editor mewa::mewa-editor)
 160   ())
 161
 162 (lol::defslot-presentation dojo-editor-slot-presentation (dojo-editor mewa::mewa-string-slot-presentation)
 163   ((document :accessor document :initarg :document)
 164    (instance :accessor instance))
 165   (:type-name dojo-editor))
 166
 167 (defmethod save-document ((self dojo-editor-slot-presentation))
 168   (setf (lol::presentation-slot-value self (instance self)) (document self)))
 169
 170 (defmethod lol::present-slot ((slot dojo-editor-slot-presentation) instance)
 171   (setf (document slot) (lol::presentation-slot-value slot instance))
 172   (setf (instance slot) instance)
 173   (render-requires slot)
 174   (render-editor slot))
 175
 176 (defmethod js-on-load ((self dojo-editor-slot-presentation))
 177  `(lambda (x)
 178     (setf document.location
 179           ,(lol::make-action-url
 180             self
 181             (answer-component (ucw::parent self) self)))))
 182
 183
 184 (defcomponent sortable-list-editor (lol::mewa-list-presentation
 185                                     dojo-component
 186                                     dojo-input-component-mixin
 187                                     dojo-output-component-mixin)
 188   ()
 189   (:default-initargs
 190       :requires '("dojo.event.*" "dojo.dnd.*" "dojo.io.*")))
 191
 192 (defmethod present-output ((self sortable-list-editor))
 193   (loop for li in (mewa::instances self)
 194          for n upfrom 0
 195          do
 196          (let ((li li))
 197            (<:li :id (format nil "~A~A" (input-id self) n)
 198                  (<:as-html (lol:present-view (li :one-line)))
 199                  (<:br)
 200                  (<ucw:a :action (lol:call-view (li :editor (call-from self)))
 201                          (<:as-html "(edit)"))
 202                  (<ucw:a :action (lol:call-view (li :editor))
 203                          (<:as-html "(remove)"))))))
 204
 205 (defmethod lol::present ((self sortable-list-editor))
 206   (<:div (<:as-html "Drag and Drop list items to change the order"))
 207   (<:ul
 208    :id (input-id self)
 209    (present-output self))
 210   (<:ul (<:li
 211          (<ucw:a :action (answer (mewa::instances self))
 212                  (<:as-html "*Save*")))
 213
 214         (<:li
 215          (<ucw:a :action (add-list-item self)
 216                  (<:as-html "*Add Item*")))
 217         (<:li
 218          (<ucw:a :action (answer nil)
 219                  (<:as-html "*Cancel*"))))
 220
 221   (<ucw:script
 222    ;;;; The Dojo example :
 223    ;;;; var dl = byId("dragList3");
 224    ;;;; new dojo.dnd.HtmlDropTarget(dl, ["li2"]);
 225    ;;;; var lis = dl.getElementsByTagName("li");
 226    ;;;; for(var x=0; x<lis.length; x++){
 227    ;;;;   new dojo.dnd.HtmlDragSource(lis[x], "li2");}
 228
 229    ;;;; and the parenscript
 230    `(dojo.event.connect dojo "loaded"
 231      (lambda ()
 232        (setf make-sortable
 233              (lambda (x)
 234                (setf ulist (document.get-element-by-id x))
 235                (setf drop (new (dojo.dnd.*html-drop-target ulist (array x))))
 236                (setf list-items (ulist.get-elements-by-tag-name "li" ))
 237                (dolist (li list-items)
 238                  (new (dojo.dnd.*html-drag-source li x)))))
 239        (make-sortable ,(input-id self))
 240
 241        (dojo.event.connect
 242         drop "onDrop"
 243         (lambda ()
 244           (dolist (li list-items)
 245             (new (dojo.dnd.*html-drag-source li ,(input-id self))))
 246           ,
 247           (with-ajax (self)
 248             (:action nil)
 249             (:callback d (let ((list-order
 250                                 (mapcar #'(lambda (x)
 251                                             (parse-integer (subseq x (length (input-id self)))))
 252                                         (read-from-string d))))
 253                            (setf (mewa::instances self) (reorder-list (mewa::instances self) list-order)))
 254                        `(progn
 255                          (setf my-list "(")
 256                          (dolist (li list-items)
 257                            (setf my-list (+ my-list "\"" li.id "\"" " ")))
 258                          (setf my-list (+ my-list ")"))
 259                          (return my-list)))
 260             (:load `(lambda (x data)
 261                      (setf (slot-value (document.get-element-by-id ,(input-id self)) inner-h-t-m-l) data)
 262                      (make-sortable ,(input-id self)))))))))))
 263
 264
 265 ;(defcomponent dojo-combo-box )