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-it :accessor render-it
: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
))))
75 (defun make-auto-complete-url (input-id)
76 "creates a url that calls the auto-complete entry-point for INPUT-ID."
77 (format nil
"auto-complete.ucw?&auto-complete-id=~A&~A=~A"
79 (ucw::session.id
(ucw::context.session ucw
::*context
*))))
81 (defaction on-submit
((l auto-complete
))
84 (defmethod js-on-select ((l auto-complete
))
85 "the javascript that is called when an item is selected"
86 (when (submit-on-select-p l
)
88 (set-action-parameter ,(register-action
95 (defmethod render ( (l auto-complete
))
96 ;; session-values are stored in an eql hash table.
97 (let ((input-key (intern (input-id l
))))
98 ;; We are storing the input components in the session,
99 ;; keyed on the string that we also use as the id for
102 (unless (get-session-value input-key
)
103 (setf (get-session-value input-key
) l
))
105 ;; A hidden field to hold the index number selected via javascript
106 (<ucw
:text
:accessor
(client-value l
)
107 :id
(input-id l
) :size
(input-size l
))
108 (<:div
:id
(output-id l
) :class
"auto-complete" (<:as-html
" ")))
109 (let* ((a (make-symbol (format nil
"~A-autocompleter" (input-id l
))))
110 (f (make-symbol (format nil
"~A.select-entry-function"a
))))
114 (*Ajax.
*Autocompleter
115 ,(input-id l
) ,(output-id l
)
116 ,(make-auto-complete-url (input-id l
))
118 :param-name
"value"))))
119 `(setf ,f
(slot-value ,a
'select-entry
))
120 `(setf (slot-value ,a
'select-entry
)
123 ,(generate-ajax-request
124 (make-auto-complete-url (input-id l
))
126 :parameters
(+ "&index=" (slot-value ,a
'index
))
128 :on-complete
(lambda (res)
129 ,(js-on-select l
)))))))))
132 ;;;; * auto-complete-ouput
135 (defcomponent auto-complete-output
(window-component)
136 ((auto-complete :initarg
:auto-complete
:accessor auto-complete
)))
138 (defmethod render ((output auto-complete-output
))
139 (let ((auto-complete (auto-complete output
)))
140 (setf (list-of-values auto-complete
)
141 (funcall (values-generator auto-complete
) (client-value auto-complete
)))
143 :class
"auto-complete-list"
144 (arnesi:dolist
* (value (list-of-values auto-complete
))
146 :class
"auto-complete-list-item"
147 (funcall (render-it auto-complete
) value
))))
148 (answer-component output t
)))
150 (defcomponent fkey-auto-complete
(auto-complete)
153 (defmethod js-on-select ((self fkey-auto-complete
))
154 (with-ajax-action (self)
155 (mewa::sync-foreign-instance
(ucw::parent self
) (value self
))))
157 (defslot-presentation ajax-foreign-key-slot-presentation
(mewa::foreign-key-slot-presentation
)
158 ((original-value :accessor original-value
:initform nil
)
159 (search-slots :accessor search-slots
:initarg
:search-slots
:initform nil
)
161 :accessor live-search
162 :component fkey-auto-complete
))
163 (:type-name ajax-foreign-key
))
166 (defmethod shared-initialize :after
((slot ajax-foreign-key-slot-presentation
) slots
&rest args
)
167 (let* ((l (live-search slot
))
168 (slot-name (slot-name slot
))
169 (instance (instance (ucw::parent slot
)))
170 (foreign-instance (explode-foreign-key instance slot-name
))
171 (class-name (class-name
172 (class-of foreign-instance
))))
173 ;; If no search-slots than use the any slots of type string
174 (unless (search-slots slot
)
175 (setf (search-slots slot
) (find-slots-of-type foreign-instance
)))
177 (setf (lisp-on-lines::values-generator l
)
179 (word-search class-name
180 (search-slots slot
) input
)))
182 (setf (lisp-on-lines::render-it l
)
184 (<ucw
:render-component
185 :component
(make-presentation val
:type
:one-line
))))))
187 (defaction revert-foreign-slot
((slot ajax-foreign-key-slot-presentation
))
188 (setf (lol::value
(live-search slot
)) nil
)
189 (when (original-value slot
)
190 (mewa::sync-foreign-instance slot
(original-value slot
))))
192 (defmethod present-slot :around
((slot ajax-foreign-key-slot-presentation
) instance
)
194 (let ((foreign-instance
195 (if (lol::value
(live-search slot
))
196 (lol::value
(live-search slot
))
197 (setf (original-value slot
)
198 (when (presentation-slot-value slot instance
)
199 (meta-model:explode-foreign-key instance
(slot-name slot
)))))))
201 (flet ((render-s () (when foreign-instance
(call-next-method))))
203 (if (slot-boundp slot
'ucw
::place
)
206 (when foreign-instance
207 (setf (client-value (live-search slot
))
208 (with-output-to-string (s)
209 (yaclml:with-yaclml-stream s
210 (present (make-presentation foreign-instance
211 :type
:one-line
))))))
213 (<ucw
:render-component
:component
(live-search slot
))
214 #+ (or) (<ucw
:submit
:action
(revert-foreign-slot slot
)
216 #+ (or) (<ucw
:submit
:action
(mewa::search-records slot instance
) :value
"find" :style
"display:inline"))
217 ((mewa::linkedp slot
)
218 (<ucw
:a
:action
(mewa::view-instance slot foreign-instance
)
222 ;; presentation is used only for rendering