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.") | |
b8c89851 | 33 | (render-it :accessor render-it :initarg :render |
3b18c689 DC |
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 | ||
3b18c689 | 74 | |
21d89532 DC |
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" | |
b8c89851 | 78 | input-id "session" |
21d89532 DC |
79 | (ucw::session.id (ucw::context.session ucw::*context*)))) |
80 | ||
81 | (defaction on-submit ((l auto-complete)) | |
82 | ()) | |
83 | ||
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) | |
87 | `(progn | |
88 | (set-action-parameter ,(register-action | |
89 | (lambda () | |
90 | (arnesi:with-call/cc | |
91 | (on-submit l))))) | |
92 | (submit-form)))) | |
93 | ||
3b18c689 | 94 | |
b8c89851 | 95 | (defmethod render ( (l auto-complete)) |
3b18c689 DC |
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 | |
100 | ;; the input field. | |
101 | ||
102 | (unless (get-session-value input-key) | |
103 | (setf (get-session-value input-key) l)) | |
104 | ||
105 | ;; A hidden field to hold the index number selected via javascript | |
3b18c689 DC |
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)))) | |
21d89532 | 110 | (f (make-symbol (format nil "~A.select-entry-function"a)))) |
3b18c689 DC |
111 | (<ucw:script |
112 | `(setf ,a | |
113 | (new | |
114 | (*Ajax.*Autocompleter | |
115 | ,(input-id l) ,(output-id l) | |
21d89532 | 116 | ,(make-auto-complete-url (input-id l)) |
3b18c689 DC |
117 | (create |
118 | :param-name "value")))) | |
119 | `(setf ,f (slot-value ,a 'select-entry)) | |
120 | `(setf (slot-value ,a 'select-entry) | |
121 | (lambda () | |
122 | (,f) | |
21d89532 DC |
123 | ,(generate-ajax-request |
124 | (make-auto-complete-url (input-id l)) | |
125 | `(create | |
126 | :parameters (+ "&index=" (slot-value ,a 'index)) | |
127 | :method "post" | |
128 | :on-complete (lambda (res) | |
129 | ,(js-on-select l))))))))) | |
3b18c689 DC |
130 | |
131 | ||
3b18c689 DC |
132 | ;;;; * auto-complete-ouput |
133 | ||
134 | ||
135 | (defcomponent auto-complete-output (window-component) | |
136 | ((auto-complete :initarg :auto-complete :accessor auto-complete))) | |
137 | ||
b8c89851 | 138 | (defmethod render ((output auto-complete-output)) |
3b18c689 | 139 | (let ((auto-complete (auto-complete output))) |
21d89532 | 140 | (setf (list-of-values auto-complete) |
3b18c689 DC |
141 | (funcall (values-generator auto-complete) (client-value auto-complete))) |
142 | (<:ul | |
143 | :class "auto-complete-list" | |
21d89532 | 144 | (arnesi:dolist* (value (list-of-values auto-complete)) |
3b18c689 DC |
145 | (<:li |
146 | :class "auto-complete-list-item" | |
b8c89851 DC |
147 | (funcall (render-it auto-complete) value)))) |
148 | (answer-component output t))) | |
3b18c689 | 149 | |
3b18c689 DC |
150 | (defcomponent fkey-auto-complete (auto-complete) |
151 | ()) | |
152 | ||
153 | (defmethod js-on-select ((self fkey-auto-complete)) | |
154 | (with-ajax-action (self) | |
21d89532 | 155 | (mewa::sync-foreign-instance (ucw::parent self) (value self)))) |
3b18c689 DC |
156 | |
157 | (defslot-presentation ajax-foreign-key-slot-presentation (mewa::foreign-key-slot-presentation) | |
21d89532 DC |
158 | ((original-value :accessor original-value :initform nil) |
159 | (search-slots :accessor search-slots :initarg :search-slots :initform nil) | |
3b18c689 DC |
160 | (live-search |
161 | :accessor live-search | |
162 | :component fkey-auto-complete)) | |
163 | (:type-name ajax-foreign-key)) | |
164 | ||
165 | ||
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))) | |
176 | ||
177 | (setf (lisp-on-lines::values-generator l) | |
178 | (lambda (input) | |
179 | (word-search class-name | |
180 | (search-slots slot) input))) | |
181 | ||
b8c89851 | 182 | (setf (lisp-on-lines::render-it l) |
3b18c689 DC |
183 | (lambda (val) |
184 | (<ucw:render-component | |
185 | :component (make-presentation val :type :one-line)))))) | |
186 | ||
21d89532 DC |
187 | (defaction revert-foreign-slot ((slot ajax-foreign-key-slot-presentation)) |
188 | (setf (lol::value (live-search slot)) nil) | |
d5e996b3 DC |
189 | (when (original-value slot) |
190 | (mewa::sync-foreign-instance slot (original-value slot)))) | |
21d89532 DC |
191 | |
192 | (defmethod present-slot :around ((slot ajax-foreign-key-slot-presentation) instance) | |
d5e996b3 | 193 | |
21d89532 DC |
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))))))) | |
200 | ||
b8c89851 | 201 | (flet ((render-s () (when foreign-instance (call-next-method)))) |
21d89532 DC |
202 | (if (slot-boundp slot 'ucw::place) |
203 | (cond | |
204 | ((editablep slot) | |
205 | (when foreign-instance | |
206 | (setf (client-value (live-search slot)) | |
207 | (with-output-to-string (s) | |
208 | (yaclml:with-yaclml-stream s | |
209 | (present (make-presentation foreign-instance | |
210 | :type :one-line)))))) | |
211 | ||
212 | (<ucw:render-component :component (live-search slot)) | |
adfb3983 | 213 | #+ (or) (<ucw:submit :action (revert-foreign-slot slot) |
21d89532 DC |
214 | :value "Undo") |
215 | (<ucw:submit :action (mewa::search-records slot instance) :value "find" :style "display:inline")) | |
216 | ((mewa::linkedp slot) | |
217 | (<ucw:a :action (mewa::view-instance slot foreign-instance) | |
b8c89851 | 218 | (render-s))) |
21d89532 | 219 | (t |
b8c89851 | 220 | (render-s))) |
21d89532 | 221 | ;; presentation is used only for rendering |
b8c89851 | 222 | (render-s))))) |