removed the Undo in ajax fkey
[clinton/lisp-on-lines.git] / src / components / ajax.lisp
CommitLineData
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 "
50There has got to be something like this buried in UCW somewhere,
51but 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)))))