(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)
(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,
(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))
(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
HCoop / clinton / lisp-on-lines.git / blobdiff