change PLIST to PROPERTIES, abstract is good.
[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.")
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 "
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
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)))))