1 (in-package :lisp-on-lines
)
3 ;;;; for when there is nothing left to display.
4 (defcomponent empty-page
(window-component)
7 (defmethod render-on ((res response
) (self empty-page
))
10 (defcomponent auto-complete
()
11 ((input-id :accessor input-id
:initform
(arnesi:random-string
10 arnesi
:+ascii-alphabet
+))
12 (output-id :accessor output-id
:initform
(arnesi:random-string
10 arnesi
:+ascii-alphabet
+))
14 :accessor client-value
16 :documentation
"The string the user has, so far, insterted.")
20 :documentation
"The index (for use with NTH) in list-of-values of the item selected via Ajax")
22 :accessor list-of-values
24 :documentation
"The list generated by values-generator")
25 (values-generator :accessor values-generator
:initarg
:values-generator
26 :documentation
"Function which, when passed the auto-complete component, returns a list of objects.")
30 :documentation
"The lisp value of the object selecting in the drop down")
31 (as-value :accessor as-value
:initarg
:as-value
32 :documentation
"Function which, when passed a value, returns the string to put in the text box.")
33 (render :accessor render
:initarg
:render
34 :documentation
"Function which, when passed the component and one of the values render it (the value).")
35 (input-size :accessor input-size
:initarg
:input-size
:initform
20)
37 :accessor submit-on-select-p
38 :initarg
:submit-on-select-p
40 (output-component-name :accessor output-component-name
:initarg
:output-comonent-name
:initform
'auto-complete-output
)))
42 (defmethod js-on-complete ((l auto-complete
))
44 (setf (slot-value (document.get-element-by-id
,(output-id l
))
46 transport.response-text
)))
48 (defmacro make-action-url
(component action
)
50 There has got to be something like this buried in UCW somewhere,
51 but here's what i use."
52 `(ucw::print-uri-to-string
53 (compute-url ,component
54 :action-id
(ucw::make-new-action
(ucw::context.current-frame
*context
*)
59 (defun generate-ajax-request (js-url &optional js-options
)
65 (defmacro with-ajax-request
(js-url &rest js-options
)
66 `(generate-ajax-request-for-url
70 (defmacro with-ajax-action
((component) &body action
)
71 `(generate-ajax-request
72 (make-action-url ,component
(progn ,@action
))))
74 (defaction call-auto-complete
((self t
) auto-complete-id value index
)
75 (let ((auto-complete (get-session-value (intern auto-complete-id
))))
78 (select-value auto-complete index
)
79 (call-auto-complete-from-output auto-complete auto-complete-id value self
))
80 (call 'empty-page
:message
(error "Cannot find")))))
82 (defaction call-auto-complete-from-output
((auto-complete auto-complete
) auto-complete-id value output
)
83 (setf (client-value auto-complete
) value
)
85 (call (output-component-name auto-complete
) :auto-complete auto-complete
)
86 (call 'empty-page
:message
(error "ASD"))))
88 (defaction select-value
((self auto-complete
) index
)
89 (let ((index (when (< 0 (length index
))
90 (parse-integer index
))))
91 (setf (index self
) index
)
92 (setf (value self
) (nth index
(list-of-values self
)))))
94 (defun make-auto-complete-url (input-id)
95 "creates a url that calls the auto-complete entry-point for INPUT-ID."
96 (format nil
"auto-complete.ucw?&auto-complete-id=~A&~A=~A"
97 input-id ucw
::+session-parameter-name
+
98 (ucw::session.id
(ucw::context.session ucw
::*context
*))))
100 (defaction on-submit
((l auto-complete
))
103 (defmethod js-on-select ((l auto-complete
))
104 "the javascript that is called when an item is selected"
105 (when (submit-on-select-p l
)
107 (set-action-parameter ,(register-action
114 (defmethod render-on ((res response
) (l auto-complete
))
115 ;; session-values are stored in an eql hash table.
116 (let ((input-key (intern (input-id l
))))
117 ;; We are storing the input components in the session,
118 ;; keyed on the string that we also use as the id for
121 (unless (get-session-value input-key
)
122 (setf (get-session-value input-key
) l
))
124 ;; A hidden field to hold the index number selected via javascript
125 (<ucw
:text
:accessor
(client-value l
)
126 :id
(input-id l
) :size
(input-size l
))
127 (<:div
:id
(output-id l
) :class
"auto-complete" (<:as-html
" ")))
128 (let* ((a (make-symbol (format nil
"~A-autocompleter" (input-id l
))))
129 (f (make-symbol (format nil
"~A.select-entry-function"a
))))
133 (*Ajax.
*Autocompleter
134 ,(input-id l
) ,(output-id l
)
135 ,(make-auto-complete-url (input-id l
))
137 :param-name
"value"))))
138 `(setf ,f
(slot-value ,a
'select-entry
))
139 `(setf (slot-value ,a
'select-entry
)
142 ,(generate-ajax-request
143 (make-auto-complete-url (input-id l
))
145 :parameters
(+ "&index=" (slot-value ,a
'index
))
147 :on-complete
(lambda (res)
148 ,(js-on-select l
)))))))))
151 ;;;; * auto-complete-ouput
154 (defcomponent auto-complete-output
(window-component)
155 ((auto-complete :initarg
:auto-complete
:accessor auto-complete
)))
157 (defmethod render-on ((res response
) (output auto-complete-output
))
158 (let ((auto-complete (auto-complete output
)))
159 (setf (list-of-values auto-complete
)
160 (funcall (values-generator auto-complete
) (client-value auto-complete
)))
162 :class
"auto-complete-list"
163 (arnesi:dolist
* (value (list-of-values auto-complete
))
165 :class
"auto-complete-list-item"
166 (funcall (render auto-complete
) value
))))))
168 (defcomponent fkey-auto-complete
(auto-complete)
171 (defmethod js-on-select ((self fkey-auto-complete
))
172 (with-ajax-action (self)
173 (mewa::sync-foreign-instance
(ucw::parent self
) (value self
))))
175 (defslot-presentation ajax-foreign-key-slot-presentation
(mewa::foreign-key-slot-presentation
)
176 ((original-value :accessor original-value
:initform nil
)
177 (search-slots :accessor search-slots
:initarg
:search-slots
:initform nil
)
179 :accessor live-search
180 :component fkey-auto-complete
))
181 (:type-name ajax-foreign-key
))
184 (defmethod shared-initialize :after
((slot ajax-foreign-key-slot-presentation
) slots
&rest args
)
185 (let* ((l (live-search slot
))
186 (slot-name (slot-name slot
))
187 (instance (instance (ucw::parent slot
)))
188 (foreign-instance (explode-foreign-key instance slot-name
))
189 (class-name (class-name
190 (class-of foreign-instance
))))
191 ;; If no search-slots than use the any slots of type string
192 (unless (search-slots slot
)
193 (setf (search-slots slot
) (find-slots-of-type foreign-instance
)))
195 (setf (lisp-on-lines::values-generator l
)
197 (word-search class-name
198 (search-slots slot
) input
)))
200 (setf (lisp-on-lines::render l
)
202 (<ucw
:render-component
203 :component
(make-presentation val
:type
:one-line
))))))
205 (defaction revert-foreign-slot
((slot ajax-foreign-key-slot-presentation
))
206 (setf (lol::value
(live-search slot
)) nil
)
207 (when (original-value slot
)
208 (mewa::sync-foreign-instance slot
(original-value slot
))))
210 (defmethod present-slot :around
((slot ajax-foreign-key-slot-presentation
) instance
)
212 (let ((foreign-instance
213 (if (lol::value
(live-search slot
))
214 (lol::value
(live-search slot
))
215 (setf (original-value slot
)
216 (when (presentation-slot-value slot instance
)
217 (meta-model:explode-foreign-key instance
(slot-name slot
)))))))
219 (flet ((render () (when foreign-instance
(call-next-method))))
220 (if (slot-boundp slot
'ucw
::place
)
223 (when foreign-instance
224 (setf (client-value (live-search slot
))
225 (with-output-to-string (s)
226 (yaclml:with-yaclml-stream s
227 (present (make-presentation foreign-instance
228 :type
:one-line
))))))
230 (<ucw
:render-component
:component
(live-search slot
))
231 (<ucw
:submit
:action
(revert-foreign-slot slot
)
233 (<ucw
:submit
:action
(mewa::search-records slot instance
) :value
"find" :style
"display:inline"))
234 ((mewa::linkedp slot
)
235 (<ucw
:a
:action
(mewa::view-instance slot foreign-instance
)
239 ;; presentation is used only for rendering