Commit | Line | Data |
---|---|---|
3b18c689 DC |
1 | (in-package :lisp-on-lines) |
2 | ||
3 | ;;;; for when there is nothing left to display. | |
4 | (defcomponent empty-page (window-component) | |
5 | ()) | |
6 | ||
7 | (defmethod render-on ((res response) (self empty-page)) | |
8 | "didnt find a thing") | |
9 | ||
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+)) | |
21d89532 DC |
13 | (client-value |
14 | :accessor client-value | |
15 | :initform "" | |
16 | :documentation "The string the user has, so far, insterted.") | |
17 | (index | |
18 | :accessor index | |
19 | :initform nil | |
20 | :documentation "The index (for use with NTH) in list-of-values of the item selected via Ajax") | |
21 | (list-of-values | |
22 | :accessor list-of-values | |
23 | :initform '() | |
24 | :documentation "The list generated by values-generator") | |
3b18c689 DC |
25 | (values-generator :accessor values-generator :initarg :values-generator |
26 | :documentation "Function which, when passed the auto-complete component, returns a list of objects.") | |
21d89532 DC |
27 | (value |
28 | :accessor value | |
29 | :initform nil | |
30 | :documentation "The lisp value of the object selecting in the drop down") | |
3b18c689 DC |
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) | |
21d89532 DC |
36 | (submit-on-select-p |
37 | :accessor submit-on-select-p | |
38 | :initarg :submit-on-select-p | |
39 | :initform t) | |
40 | (output-component-name :accessor output-component-name :initarg :output-comonent-name :initform 'auto-complete-output))) | |
3b18c689 DC |
41 | |
42 | (defmethod js-on-complete ((l auto-complete)) | |
43 | `(lambda (transport) | |
44 | (setf (slot-value (document.get-element-by-id ,(output-id l)) | |
45 | 'inner-h-t-m-l) | |
46 | transport.response-text))) | |
47 | ||
48 | (defmacro make-action-url (component action) | |
49 | " | |
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*) | |
55 | (lambda () | |
56 | (arnesi:with-call/cc | |
57 | ,action)))))) | |
58 | ||
21d89532 | 59 | (defun generate-ajax-request (js-url &optional js-options) |
3b18c689 DC |
60 | `(new |
61 | (*Ajax.*Request | |
21d89532 DC |
62 | ,js-url |
63 | ,js-options))) | |
3b18c689 | 64 | |
21d89532 DC |
65 | (defmacro with-ajax-request (js-url &rest js-options) |
66 | `(generate-ajax-request-for-url | |
67 | ,js-url | |
68 | ,@js-options)) | |
69 | ||
70 | (defmacro with-ajax-action ((component) &body action) | |
71 | `(generate-ajax-request | |
72 | (make-action-url ,component (progn ,@action)))) | |
73 | ||
74 | (defaction call-auto-complete ((self t) auto-complete-id value index) | |
3b18c689 DC |
75 | (let ((auto-complete (get-session-value (intern auto-complete-id)))) |
76 | (if auto-complete | |
21d89532 DC |
77 | (if index |
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"))))) | |
3b18c689 DC |
81 | |
82 | (defaction call-auto-complete-from-output ((auto-complete auto-complete) auto-complete-id value output) | |
83 | (setf (client-value auto-complete) value) | |
84 | (let ((self output)) | |
21d89532 | 85 | (call (output-component-name auto-complete) :auto-complete auto-complete) |
3b18c689 DC |
86 | (call 'empty-page :message (error "ASD")))) |
87 | ||
21d89532 DC |
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))))) | |
3b18c689 | 93 | |
21d89532 DC |
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*)))) | |
99 | ||
100 | (defaction on-submit ((l auto-complete)) | |
101 | ()) | |
102 | ||
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) | |
106 | `(progn | |
107 | (set-action-parameter ,(register-action | |
108 | (lambda () | |
109 | (arnesi:with-call/cc | |
110 | (on-submit l))))) | |
111 | (submit-form)))) | |
112 | ||
3b18c689 | 113 | |
3b18c689 DC |
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 | |
119 | ;; the input field. | |
120 | ||
121 | (unless (get-session-value input-key) | |
122 | (setf (get-session-value input-key) l)) | |
123 | ||
124 | ;; A hidden field to hold the index number selected via javascript | |
3b18c689 DC |
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)))) | |
21d89532 | 129 | (f (make-symbol (format nil "~A.select-entry-function"a)))) |
3b18c689 DC |
130 | (<ucw:script |
131 | `(setf ,a | |
132 | (new | |
133 | (*Ajax.*Autocompleter | |
134 | ,(input-id l) ,(output-id l) | |
21d89532 | 135 | ,(make-auto-complete-url (input-id l)) |
3b18c689 DC |
136 | (create |
137 | :param-name "value")))) | |
138 | `(setf ,f (slot-value ,a 'select-entry)) | |
139 | `(setf (slot-value ,a 'select-entry) | |
140 | (lambda () | |
141 | (,f) | |
21d89532 DC |
142 | ,(generate-ajax-request |
143 | (make-auto-complete-url (input-id l)) | |
144 | `(create | |
145 | :parameters (+ "&index=" (slot-value ,a 'index)) | |
146 | :method "post" | |
147 | :on-complete (lambda (res) | |
148 | ,(js-on-select l))))))))) | |
3b18c689 DC |
149 | |
150 | ||
3b18c689 DC |
151 | ;;;; * auto-complete-ouput |
152 | ||
153 | ||
154 | (defcomponent auto-complete-output (window-component) | |
155 | ((auto-complete :initarg :auto-complete :accessor auto-complete))) | |
156 | ||
157 | (defmethod render-on ((res response) (output auto-complete-output)) | |
158 | (let ((auto-complete (auto-complete output))) | |
21d89532 | 159 | (setf (list-of-values auto-complete) |
3b18c689 DC |
160 | (funcall (values-generator auto-complete) (client-value auto-complete))) |
161 | (<:ul | |
162 | :class "auto-complete-list" | |
21d89532 | 163 | (arnesi:dolist* (value (list-of-values auto-complete)) |
3b18c689 DC |
164 | (<:li |
165 | :class "auto-complete-list-item" | |
166 | (funcall (render auto-complete) value)))))) | |
167 | ||
3b18c689 DC |
168 | (defcomponent fkey-auto-complete (auto-complete) |
169 | ()) | |
170 | ||
171 | (defmethod js-on-select ((self fkey-auto-complete)) | |
172 | (with-ajax-action (self) | |
21d89532 | 173 | (mewa::sync-foreign-instance (ucw::parent self) (value self)))) |
3b18c689 DC |
174 | |
175 | (defslot-presentation ajax-foreign-key-slot-presentation (mewa::foreign-key-slot-presentation) | |
21d89532 DC |
176 | ((original-value :accessor original-value :initform nil) |
177 | (search-slots :accessor search-slots :initarg :search-slots :initform nil) | |
3b18c689 DC |
178 | (live-search |
179 | :accessor live-search | |
180 | :component fkey-auto-complete)) | |
181 | (:type-name ajax-foreign-key)) | |
182 | ||
183 | ||
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))) | |
194 | ||
195 | (setf (lisp-on-lines::values-generator l) | |
196 | (lambda (input) | |
197 | (word-search class-name | |
198 | (search-slots slot) input))) | |
199 | ||
200 | (setf (lisp-on-lines::render l) | |
201 | (lambda (val) | |
202 | (<ucw:render-component | |
203 | :component (make-presentation val :type :one-line)))))) | |
204 | ||
21d89532 DC |
205 | (defaction revert-foreign-slot ((slot ajax-foreign-key-slot-presentation)) |
206 | (setf (lol::value (live-search slot)) nil) | |
d5e996b3 DC |
207 | (when (original-value slot) |
208 | (mewa::sync-foreign-instance slot (original-value slot)))) | |
21d89532 DC |
209 | |
210 | (defmethod present-slot :around ((slot ajax-foreign-key-slot-presentation) instance) | |
d5e996b3 | 211 | |
21d89532 DC |
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))))))) | |
218 | ||
219 | (flet ((render () (when foreign-instance (call-next-method)))) | |
220 | (if (slot-boundp slot 'ucw::place) | |
221 | (cond | |
222 | ((editablep slot) | |
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)))))) | |
229 | ||
230 | (<ucw:render-component :component (live-search slot)) | |
adfb3983 | 231 | #+ (or) (<ucw:submit :action (revert-foreign-slot slot) |
21d89532 DC |
232 | :value "Undo") |
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) | |
236 | (render))) | |
237 | (t | |
238 | (render))) | |
239 | ;; presentation is used only for rendering | |
240 | (render))))) |