From: Drew Crampsie <drewc@tech.coop>
Date: Thu, 2 Feb 2006 08:37:03 +0000 (-0800)
Subject: added forgotten dojo.lisp.
X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/commitdiff_plain/41af2f6d60968319e6dd29a6ffdf42a6c88fa66b

added forgotten dojo.lisp.

darcs-hash:20060202083703-5417e-eba22c64ac96eadc603f22a0283f93a42a9ab29e.gz
---

diff --git a/src/components/dojo.lisp b/src/components/dojo.lisp
new file mode 100644
index 0000000..c1d36a9
--- /dev/null
+++ b/src/components/dojo.lisp
@@ -0,0 +1,265 @@
+(in-package :lol)
+
+
+;;;; * Dojo Javascript Components
+(defcomponent dojo-component ()
+  ((requires :accessor requires :initarg :requires :initform nil)))
+
+(defmethod render-requires ((self dojo-component))
+  (<ucw:script `(progn ,@(loop for r in (requires self)
+			       collect `(dojo.require ,r)))))
+
+(defmethod render :wrapping ( (self dojo-component))
+  (render-requires self)
+  (call-next-method))
+
+(defmethod lol::present :around ((self dojo-component))
+  (render-requires self)
+  (call-next-method))
+
+(defcomponent dojo-ajax-output-component (window-component)
+  ((component :accessor component :initarg :component :component dojo-component)))
+
+(defmethod render ((self dojo-ajax-output-component))
+  (lol::present self))
+
+(defmethod lol::present ((self dojo-ajax-output-component))
+  (present-output (component self)))
+
+(defcomponent dojo-input-component-mixin ()
+  ((input-id
+    :accessor input-id
+    :initform (arnesi:random-string 32 arnesi::+ALPHANUMERIC-ASCII-ALPHABET+))))
+
+(defcomponent dojo-output-component-mixin ()
+  ((output-id
+    :accessor output-id
+    :initform (arnesi:random-string 32 arnesi::+ALPHANUMERIC-ASCII-ALPHABET+))
+   (output-component
+    :accessor output-component
+    :component dojo-ajax-output-component)))
+
+(defmethod shared-initialize :after ((self dojo-output-component-mixin) slots &rest args)
+  (declare (ignore slots args))
+  (setf (component (output-component self)) self))
+
+
+(defmacro with-ajax ((component) &body args)  
+  (multiple-value-bind (actions callbacks args output)
+      (loop for arg in args
+	    if (eql (car arg) :action)
+	    nconc (cdr arg) into actions
+	    else if (eql (car arg) :callback)
+	    collect (cdr arg) into callbacks
+	    else if (eql (car arg) :output-to)
+	    nconc (cdr arg) into output
+	    else
+	    nconc arg into args
+	    finally (return (values actions callbacks args output)))
+      `(js:with-unique-js-names (js-callbacks)
+	`(progn
+	  (setf ,js-callbacks (array))
+	  ,,@(loop for c in callbacks
+		   for i upfrom 0
+		   collect 
+		   ``(setf (aref ,js-callbacks ,,i)
+		      (lambda () ,,(third c))))
+	  (dojo.io.bind
+		(create
+		 ,@(unless
+		    ,(getf args :url)
+		    `(:url
+		      ,(lol::make-action-url
+			,component
+			(progn
+			  ,@actions
+			  (call-component nil (output-component self))))))
+		 ,@ (unless
+			,(getf args :post-content)
+		      `(:post-content (+ ,,@(loop for c in callbacks
+						  for n upfrom 0
+						  nconc `((ucw::make-new-callback
+							   
+							   (lambda (,(car c))
+							     ,(second c)))
+							  "="
+							  `(encode-u-r-i-component ((aref ,js-callbacks ,,n)))
+							  "&")))))
+		 ,@ (unless
+			,(or (getf args :load) (not output) ) 
+		      `(:load
+			(lambda (evt data)
+			  (setf (slot-value (document.get-element-by-id ,,@output) inner-h-t-m-l) data))))
+		 ,,:method "post"
+		 ,,@args))))))
+
+
+
+
+
+;;;; ** Editor
+
+(defcomponent dojo-editor (dojo-component dojo-input-component-mixin)
+  ((document :accessor document :initarg :document :initform "test"))
+  (:default-initargs
+      :requires '("dojo.event.*" "dojo.widget.Editor" "dojo.io.*" "dojo.widget.RichText")))
+
+(defmethod save-document ((self dojo-editor))
+  t)
+
+(defmethod js-on-load ((self dojo-editor))
+  `(lambda (x)
+    (setf document.location
+	  ,(lol::make-action-url
+	    self
+	    (answer self)))))
+
+(defmethod render-editor ((self dojo-editor))
+  (<ucw:script
+   `(dojo.add-on-load
+     (lambda ()
+       (setf div (document.get-element-by-id ,(input-id self)))
+       (setf editor (dojo.widget.from-script
+		     "Editor"
+		     (create) div))
+       (setf save
+	     (create
+	      :save-to-server
+	      (lambda ()
+		(dojo.io.bind
+		 (create
+		  :method "post"
+		  :post-content (+
+				 ,(ucw::make-new-callback
+				   
+				   (lambda (x)
+				     (setf (document self) x)))
+				 "="
+				 (encode-u-r-i-component (editor.get-html)))
+		  :url 
+		  ,(lol::make-action-url
+		    self
+		    (save-document self))
+				     
+		  :load ,(js-on-load self))))))
+       (dojo.event.kw-connect
+	(create :type "before"
+		:src-obj editor
+		:src-func "onSave"
+		:target-obj save
+		:target-func "saveToServer")))))
+  (<:div :class "editor"
+	 (<:div
+   :id (input-id self)
+   (<:as-is (document self)))))
+
+(defmethod render ((self dojo-editor))
+  (render-editor self))
+
+(defcomponent dojo-editor-presentation (dojo-editor mewa::mewa-editor)
+  ())
+
+(lol::defslot-presentation dojo-editor-slot-presentation (dojo-editor mewa::mewa-string-slot-presentation)
+  ((document :accessor document :initarg :document)
+   (instance :accessor instance))
+  (:type-name dojo-editor))
+
+(defmethod save-document ((self dojo-editor-slot-presentation))
+  (setf (lol::presentation-slot-value self (instance self)) (document self)))
+
+(defmethod lol::present-slot ((slot dojo-editor-slot-presentation) instance)
+  (setf (document slot) (lol::presentation-slot-value slot instance))
+  (setf (instance slot) instance)
+  (render-requires slot)
+  (render-editor slot))
+
+(defmethod js-on-load ((self dojo-editor-slot-presentation))
+ `(lambda (x)
+    (setf document.location
+	  ,(lol::make-action-url
+	    self
+	    (answer-component (ucw::parent self) self)))))
+
+
+(defcomponent sortable-list-editor (lol::mewa-list-presentation
+				    dojo-component
+				    dojo-input-component-mixin
+				    dojo-output-component-mixin)
+  ()
+  (:default-initargs
+      :requires '("dojo.event.*" "dojo.dnd.*" "dojo.io.*")))
+
+(defmethod present-output ((self sortable-list-editor))
+  (loop for li in (mewa::instances self)
+	 for n upfrom 0
+	 do
+	 (let ((li li))
+	   (<:li :id (format nil "~A~A" (input-id self) n)
+		 (<:as-html (lol:present-view (li :one-line)))
+		 (<:br)
+		 (<ucw:a :action (lol:call-view (li :editor (call-from self)))
+			 (<:as-html "(edit)"))
+		 (<ucw:a :action (lol:call-view (li :editor))
+			 (<:as-html "(remove)"))))))
+
+(defmethod lol::present ((self sortable-list-editor))
+  (<:div (<:as-html "Drag and Drop list items to change the order"))
+  (<:ul
+   :id (input-id self)
+   (present-output self))
+  (<:ul (<:li
+	 (<ucw:a :action (answer (mewa::instances self))
+		 (<:as-html "*Save*")))
+   
+	(<:li 
+	 (<ucw:a :action (add-list-item self)
+		 (<:as-html "*Add Item*")))
+	(<:li 
+	 (<ucw:a :action (answer nil)
+		 (<:as-html "*Cancel*"))))
+
+  (<ucw:script
+   ;;;; The Dojo example :
+   ;;;; var dl = byId("dragList3");
+   ;;;; new dojo.dnd.HtmlDropTarget(dl, ["li2"]);
+   ;;;; var lis = dl.getElementsByTagName("li");
+   ;;;; for(var x=0; x<lis.length; x++){
+   ;;;;   new dojo.dnd.HtmlDragSource(lis[x], "li2");}
+
+   ;;;; and the parenscript	
+   `(dojo.event.connect dojo "loaded"
+     (lambda ()
+       (setf make-sortable
+	     (lambda (x)
+	       (setf ulist (document.get-element-by-id x))
+	       (setf drop (new (dojo.dnd.*html-drop-target ulist (array x))))
+	       (setf list-items (ulist.get-elements-by-tag-name "li" ))
+	       (dolist (li list-items)
+		 (new (dojo.dnd.*html-drag-source li x)))))
+       (make-sortable ,(input-id self))
+       
+       (dojo.event.connect
+	drop "onDrop"
+	(lambda ()
+	  (dolist (li list-items)
+	    (new (dojo.dnd.*html-drag-source li ,(input-id self))))
+	  ,
+	  (with-ajax (self)
+	    (:action nil)
+	    (:callback d (let ((list-order
+				(mapcar #'(lambda (x)
+					    (parse-integer (subseq x (length (input-id self)))))
+					(read-from-string d))))
+			   (setf (mewa::instances self) (reorder-list (mewa::instances self) list-order))) 
+		       `(progn
+			 (setf my-list "(")
+			 (dolist (li list-items)
+			   (setf my-list (+ my-list "\"" li.id "\"" " ")))
+			 (setf my-list (+ my-list ")"))
+			 (return my-list)))
+	    (:load `(lambda (x data)
+		     (setf (slot-value (document.get-element-by-id ,(input-id self)) inner-h-t-m-l) data)
+		     (make-sortable ,(input-id self)))))))))))
+
+
+;(defcomponent dojo-combo-box )
\ No newline at end of file