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
+))
13 (index-id :accessor index-id
:initform
(arnesi:random-string
10 arnesi
:+ascii-alphabet
+))
14 (client-value :accessor client-value
:initform
"" :documentation
"The string the user has, so far, insterted.")
15 (selected-value-index :accessor selected-value-index
:initform nil
:documentation
"The index in value-list of the item selected via Ajax")
16 (value-list :accessor value-list
:initform
'())
17 (values-generator :accessor values-generator
:initarg
:values-generator
18 :documentation
"Function which, when passed the auto-complete component, returns a list of objects.")
19 (as-value :accessor as-value
:initarg
:as-value
20 :documentation
"Function which, when passed a value, returns the string to put in the text box.")
21 (render :accessor render
:initarg
:render
22 :documentation
"Function which, when passed the component and one of the values render it (the value).")
23 (input-size :accessor input-size
:initarg
:input-size
:initform
20)
24 (submit-on-click-p :accessor submit-on-click-p
:initarg
:submit-on-click-p
:initform t
)
25 (output-component :accessor output-component
:initarg
:output-component
:initform
'auto-complete-output
)))
27 (defmethod js-on-complete ((l auto-complete
))
29 (setf (slot-value (document.get-element-by-id
,(output-id l
))
31 transport.response-text
)))
33 (defmacro make-action-url
(component action
)
35 There has got to be something like this buried in UCW somewhere,
36 but here's what i use."
37 `(ucw::print-uri-to-string
38 (compute-url ,component
39 :action-id
(ucw::make-new-action
(ucw::context.current-frame
*context
*)
44 (defmethod generate-ajax-request-for-action ((l auto-complete
) &key
(action-url "index.ucw"))
50 (defmacro with-ajax-action
((component) &body action
)
51 `(generate-ajax-request-for-action ,component
52 :action-url
(make-action-url ,component
(progn ,@action
))))
55 (defaction call-auto-complete
((self t
) auto-complete-id value
)
56 (let ((auto-complete (get-session-value (intern auto-complete-id
))))
58 (call-auto-complete-from-output auto-complete auto-complete-id value self
)
59 (call 'empty-page
:message
(error "ASD")))))
61 (defaction call-auto-complete-from-output
((auto-complete auto-complete
) auto-complete-id value output
)
62 (setf (client-value auto-complete
) value
)
64 (call (output-component auto-complete
) :auto-complete auto-complete
)
65 (call 'empty-page
:message
(error "ASD"))))
69 (defmethod js-on-select ((l auto-complete
)))
71 (defmethod render-on ((res response
) (l auto-complete
))
72 ;; session-values are stored in an eql hash table.
73 (let ((input-key (intern (input-id l
))))
74 ;; We are storing the input components in the session,
75 ;; keyed on the string that we also use as the id for
78 (unless (get-session-value input-key
)
79 (setf (get-session-value input-key
) l
))
81 ;; A hidden field to hold the index number selected via javascript
82 (<ucw
:input
:type
"hidden"
83 :accessor
(selected-value-index l
)
85 (<ucw
:text
:accessor
(client-value l
)
86 :id
(input-id l
) :size
(input-size l
))
87 (<:div
:id
(output-id l
) :class
"auto-complete" (<:as-html
" ")))
88 (let* ((a (make-symbol (format nil
"~A-autocompleter" (input-id l
))))
89 (f (make-symbol (format nil
"~A.select-entry-function"a
))))
94 ,(input-id l
) ,(output-id l
)
95 ,(format nil
"auto-complete.ucw?&auto-complete-id=~A&~A=~A"
96 (input-id l
) ucw
::+session-parameter-name
+
97 (ucw::session.id
(ucw::context.session ucw
::*context
*)))
99 :param-name
"value"))))
100 `(setf ,f
(slot-value ,a
'select-entry
))
101 `(setf (slot-value ,a
'select-entry
)
104 (setf (slot-value (document.get-element-by-id
,(index-id l
)) 'value
)
105 (slot-value ,a
'index
))
110 (defmethod find-selected-object ((self auto-complete
))
111 (if (< 0 (length (selected-value-index self
)))
112 (nth (parse-integer (selected-value-index self
))
116 ;;;; * auto-complete-ouput
119 (defcomponent auto-complete-output
(window-component)
120 ((auto-complete :initarg
:auto-complete
:accessor auto-complete
)))
122 (defmethod render-on ((res response
) (output auto-complete-output
))
123 (let ((auto-complete (auto-complete output
)))
124 (setf (value-list auto-complete
)
125 (funcall (values-generator auto-complete
) (client-value auto-complete
)))
127 :class
"auto-complete-list"
128 (arnesi:dolist
* (value (value-list auto-complete
))
130 :class
"auto-complete-list-item"
131 (funcall (render auto-complete
) value
))))))
134 (defcomponent fkey-auto-complete
(auto-complete)
137 (defmethod js-on-select ((self fkey-auto-complete
))
138 (with-ajax-action (self)
139 (mewa::sync-foreign-instance
(ucw::parent self
) (find-selected-object self
))))
141 (defslot-presentation ajax-foreign-key-slot-presentation
(mewa::foreign-key-slot-presentation
)
142 ((search-slots :accessor search-slots
:initarg
:search-slots
:initform nil
)
144 :accessor live-search
145 :component fkey-auto-complete
))
146 (:type-name ajax-foreign-key
))
149 (defmethod shared-initialize :after
((slot ajax-foreign-key-slot-presentation
) slots
&rest args
)
150 (let* ((l (live-search slot
))
151 (slot-name (slot-name slot
))
152 (instance (instance (ucw::parent slot
)))
153 (foreign-instance (explode-foreign-key instance slot-name
))
154 (class-name (class-name
155 (class-of foreign-instance
))))
156 ;; If no search-slots than use the any slots of type string
157 (unless (search-slots slot
)
158 (setf (search-slots slot
) (find-slots-of-type foreign-instance
)))
160 (setf (lisp-on-lines::values-generator l
)
162 (word-search class-name
163 (search-slots slot
) input
)))
165 (setf (lisp-on-lines::render l
)
167 (<ucw
:render-component
168 :component
(make-presentation val
:type
:one-line
))))))
172 (defmethod present-slot :around
((slot ajax-foreign-key-slot-presentation
) instance
)
173 (setf (mewa::foreign-instance slot
)
174 (when (presentation-slot-value slot instance
)
175 (meta-model:explode-foreign-key instance
(slot-name slot
))))
176 (flet ((render () (when (mewa::foreign-instance slot
)(call-next-method))))
177 (if (slot-boundp slot
'ucw
::place
)
180 (<ucw
:render-component
:component
(live-search slot
))
181 (<ucw
:submit
:action
(mewa::search-records slot instance
) :value
"find" :style
"display:inline"))
182 ((mewa::linkedp slot
)
183 (<ucw
:a
:action
(mewa::view-instance slot
(foreign-instance slot
))
187 ;; presentation is used only for rendering