X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/3b18c6893106d2ed7f7bfc175210a3cca12088d4..d0301620ac9aa7d8170ba628df493c1ff1e1d2fa:/src/components/ajax.lisp

diff --git a/src/components/ajax.lisp b/src/components/ajax.lisp
index fa9f2d6..6b4f23f 100644
--- a/src/components/ajax.lisp
+++ b/src/components/ajax.lisp
@@ -10,19 +10,34 @@
 (defcomponent auto-complete ()
   ((input-id :accessor input-id :initform (arnesi:random-string 10 arnesi:+ascii-alphabet+))
    (output-id :accessor output-id :initform (arnesi:random-string 10 arnesi:+ascii-alphabet+))
-   (index-id :accessor index-id :initform (arnesi:random-string 10 arnesi:+ascii-alphabet+))
-   (client-value :accessor client-value :initform "" :documentation "The string the user has, so far, insterted.")
-   (selected-value-index :accessor selected-value-index :initform nil :documentation "The index in value-list of the item selected via Ajax")
-   (value-list :accessor value-list :initform '())
+   (client-value 
+    :accessor client-value 
+    :initform "" 
+    :documentation "The string the user has, so far, insterted.")
+   (index 
+    :accessor index 
+    :initform nil 
+    :documentation "The index (for use with NTH) in list-of-values of the item selected via Ajax")
+   (list-of-values 
+    :accessor list-of-values 
+    :initform '() 
+    :documentation "The list generated by values-generator")
    (values-generator :accessor values-generator :initarg :values-generator
                      :documentation "Function which, when passed the auto-complete component, returns a list of objects.")
+   (value 
+    :accessor value
+    :initform nil
+    :documentation  "The lisp value of the object selecting in the drop down")
    (as-value :accessor as-value :initarg :as-value
              :documentation "Function which, when passed a value, returns the string to put in the text box.")
-   (render :accessor render :initarg :render
+   (render-it :accessor render-it :initarg :render
            :documentation "Function which, when passed the component and one of the values render it (the value).")
    (input-size :accessor input-size :initarg :input-size :initform 20)
-   (submit-on-click-p :accessor submit-on-click-p :initarg :submit-on-click-p :initform t)
-   (output-component :accessor output-component :initarg :output-component :initform 'auto-complete-output)))
+   (submit-on-select-p 
+    :accessor submit-on-select-p 
+    :initarg :submit-on-select-p 
+    :initform t)
+   (output-component-name :accessor output-component-name :initarg :output-comonent-name :initform 'auto-complete-output)))
 
 (defmethod js-on-complete ((l auto-complete))
   `(lambda (transport) 
@@ -41,34 +56,43 @@ but here's what i use."
 		   (arnesi:with-call/cc
 		     ,action))))))
 
-(defmethod generate-ajax-request-for-action ((l auto-complete) &key (action-url "index.ucw"))
+(defun generate-ajax-request (js-url &optional js-options)
   `(new 
     (*Ajax.*Request 
-     ,action-url 
-     (create))))
-	       
-(defmacro with-ajax-action ((component) &body action)
-  `(generate-ajax-request-for-action ,component 
-    :action-url (make-action-url ,component (progn ,@action)))) 
-								      
-
-(defaction call-auto-complete ((self t) auto-complete-id value)
-    (let ((auto-complete (get-session-value (intern auto-complete-id))))
-    (if auto-complete
-        (call-auto-complete-from-output auto-complete auto-complete-id value self)
-        (call 'empty-page :message (error "ASD")))))
+     ,js-url 
+     ,js-options)))
 
-(defaction call-auto-complete-from-output ((auto-complete auto-complete) auto-complete-id value output)
-  (setf (client-value auto-complete) value)
-  (let ((self output))
-    (call (output-component auto-complete) :auto-complete auto-complete)
-    (call 'empty-page :message (error "ASD"))))
+(defmacro with-ajax-request (js-url &rest js-options)
+  `(generate-ajax-request-for-url 
+    ,js-url
+    ,@js-options))
+  
+(defmacro with-ajax-action ((component) &body action)
+  `(generate-ajax-request
+    (make-action-url ,component (progn ,@action)))) 
+	
 
+(defun make-auto-complete-url (input-id)
+  "creates a url that calls the auto-complete entry-point for INPUT-ID."
+  (format nil "auto-complete.ucw?&auto-complete-id=~A&~A=~A" 
+	  input-id  "session"  
+	  (ucw::session.id (ucw::context.session ucw::*context*))))
 
+(defaction on-submit ((l auto-complete))
+  ())
 
-(defmethod js-on-select ((l auto-complete)))
-  
-(defmethod render-on ((res response) (l auto-complete))
+(defmethod js-on-select ((l auto-complete))
+  "the javascript that is called when an item is selected"
+  (when (submit-on-select-p l)
+    `(progn
+      (set-action-parameter ,(register-action
+			      (lambda () 
+				  (arnesi:with-call/cc 
+				    (on-submit l)))))
+      (submit-form))))
+   
+
+(defmethod render ( (l auto-complete))
   ;; session-values are stored in an eql hash table.
   (let ((input-key (intern (input-id l))))
     ;; We are storing the input components in the session,
@@ -79,67 +103,60 @@ but here's what i use."
       (setf (get-session-value input-key) l))
     
     ;; A hidden field to hold the index number selected via javascript
-    (<ucw:input :type "hidden" 
-		:accessor (selected-value-index l)
-		:id (index-id l))
     (<ucw:text :accessor (client-value l)
 	       :id (input-id l) :size (input-size l))
     (<:div :id (output-id l) :class "auto-complete" (<:as-html " ")))
   (let* ((a (make-symbol (format nil "~A-autocompleter" (input-id l))))
-	(f (make-symbol (format nil "~A.select-entry-function"a))))
+	 (f (make-symbol (format nil "~A.select-entry-function"a))))
     (<ucw:script 
      `(setf ,a
        (new 
 	(*Ajax.*Autocompleter 
 	 ,(input-id l) ,(output-id l) 
-	 ,(format nil "auto-complete.ucw?&auto-complete-id=~A&~A=~A" 
-		  (input-id l) ucw::+session-parameter-name+ 
-		  (ucw::session.id (ucw::context.session ucw::*context*)))
+	 ,(make-auto-complete-url (input-id l))
 	 (create
 	  :param-name "value"))))
      `(setf ,f (slot-value ,a 'select-entry))
      `(setf (slot-value ,a 'select-entry)
        (lambda () 
 	 (,f)
-	 (setf (slot-value (document.get-element-by-id ,(index-id l)) 'value)
-	       (slot-value ,a 'index))
-	 ,(js-on-select l)
-	 )))))
+	 ,(generate-ajax-request
+	   (make-auto-complete-url (input-id l))
+	   `(create 
+	     :parameters (+ "&index=" (slot-value ,a 'index))
+	     :method "post"
+	     :on-complete (lambda (res)
+			    ,(js-on-select l)))))))))
      
 
-(defmethod find-selected-object ((self auto-complete))
-  (if (< 0 (length (selected-value-index self)))
-      (nth (parse-integer (selected-value-index self))
-	   (value-list self))))
-
-
 ;;;; * auto-complete-ouput 
 
 
 (defcomponent auto-complete-output (window-component)
   ((auto-complete :initarg :auto-complete :accessor auto-complete)))
 
-(defmethod render-on ((res response) (output auto-complete-output))
+(defmethod render ((output auto-complete-output))
   (let ((auto-complete (auto-complete output)))
-    (setf (value-list auto-complete)
+    (setf (list-of-values auto-complete)
 	  (funcall (values-generator auto-complete) (client-value auto-complete)))
     (<:ul 
      :class "auto-complete-list" 
-     (arnesi:dolist* (value (value-list auto-complete))
+     (arnesi:dolist* (value (list-of-values auto-complete))
        (<:li 
 	:class "auto-complete-list-item"
-	(funcall (render auto-complete) value))))))
-
+	(funcall (render-it auto-complete) value))))
+    (answer-component output t)))
 
 (defcomponent fkey-auto-complete (auto-complete)
   ())
 
 (defmethod js-on-select ((self fkey-auto-complete))
   (with-ajax-action (self)
-    (mewa::sync-foreign-instance (ucw::parent self) (find-selected-object self))))
+    (mewa::sync-foreign-instance (ucw::parent self) (value self))))
 
 (defslot-presentation ajax-foreign-key-slot-presentation (mewa::foreign-key-slot-presentation)
-  ((search-slots :accessor search-slots :initarg :search-slots :initform nil)
+  ((original-value :accessor original-value :initform nil) 
+   (search-slots :accessor search-slots :initarg :search-slots :initform nil)
    (live-search 
      :accessor live-search
      :component fkey-auto-complete))
@@ -162,27 +179,44 @@ but here's what i use."
 	    (word-search class-name  
 			 (search-slots slot)  input)))
 		    
-    (setf (lisp-on-lines::render l)
+    (setf (lisp-on-lines::render-it l)
 	  (lambda (val) 
 	    (<ucw:render-component 
 	     :component (make-presentation val :type :one-line))))))
 	  
-
-
-(defmethod  present-slot :around ((slot ajax-foreign-key-slot-presentation) instance)  
-  (setf (mewa::foreign-instance slot) 
-	(when (presentation-slot-value slot instance) 
-	  (meta-model:explode-foreign-key instance (slot-name slot))))
-  (flet ((render () (when (mewa::foreign-instance slot)(call-next-method))))
-    (if (slot-boundp slot 'ucw::place)
-        (cond 
-          ((editablep slot)
-	   (<ucw:render-component :component (live-search slot))
-           (<ucw:submit :action  (mewa::search-records slot instance) :value "find" :style "display:inline"))
-          ((mewa::linkedp slot)
-           (<ucw:a :action (mewa::view-instance slot (foreign-instance slot)) 
-                   (render)))
-          (t       
-           (render)))
-	;; presentation is used only for rendering
-        (render))))
\ No newline at end of file
+(defaction revert-foreign-slot ((slot ajax-foreign-key-slot-presentation))
+  (setf (lol::value (live-search slot)) nil)
+  (when (original-value slot)
+  (mewa::sync-foreign-instance slot (original-value slot))))
+
+(defmethod present-slot :around ((slot ajax-foreign-key-slot-presentation) instance)
+
+  (let ((foreign-instance 
+	 (if (lol::value (live-search slot))
+	     (lol::value (live-search slot))
+	     (setf (original-value slot)
+		   (when (presentation-slot-value slot instance) 
+		     (meta-model:explode-foreign-key instance (slot-name slot)))))))
+    
+    (flet ((render-s () (when foreign-instance (call-next-method))))
+      (if (slot-boundp slot 'ucw::place)
+	  (cond 
+	    ((editablep slot)
+	     (when  foreign-instance
+	       (setf (client-value (live-search slot))
+		     (with-output-to-string (s)
+		       (yaclml:with-yaclml-stream s 
+			 (present (make-presentation foreign-instance
+						     :type :one-line))))))
+	    
+	     (<ucw:render-component :component (live-search slot))
+	     #+ (or) (<ucw:submit :action (revert-foreign-slot slot)
+			  :value "Undo")
+			      (<ucw:submit :action  (mewa::search-records slot instance) :value "find" :style "display:inline"))
+	    ((mewa::linkedp slot)
+	     (<ucw:a :action (mewa::view-instance slot foreign-instance) 
+		     (render-s)))
+	    (t       
+	     (render-s)))
+	  ;; presentation is used only for rendering
+	  (render-s)))))
\ No newline at end of file