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+)) | |
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))) | |
26 | ||
27 | (defmethod js-on-complete ((l auto-complete)) | |
28 | `(lambda (transport) | |
29 | (setf (slot-value (document.get-element-by-id ,(output-id l)) | |
30 | 'inner-h-t-m-l) | |
31 | transport.response-text))) | |
32 | ||
33 | (defmacro make-action-url (component action) | |
34 | " | |
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*) | |
40 | (lambda () | |
41 | (arnesi:with-call/cc | |
42 | ,action)))))) | |
43 | ||
44 | (defmethod generate-ajax-request-for-action ((l auto-complete) &key (action-url "index.ucw")) | |
45 | `(new | |
46 | (*Ajax.*Request | |
47 | ,action-url | |
48 | (create)))) | |
49 | ||
50 | (defmacro with-ajax-action ((component) &body action) | |
51 | `(generate-ajax-request-for-action ,component | |
52 | :action-url (make-action-url ,component (progn ,@action)))) | |
53 | ||
54 | ||
55 | (defaction call-auto-complete ((self t) auto-complete-id value) | |
56 | (let ((auto-complete (get-session-value (intern auto-complete-id)))) | |
57 | (if auto-complete | |
58 | (call-auto-complete-from-output auto-complete auto-complete-id value self) | |
59 | (call 'empty-page :message (error "ASD"))))) | |
60 | ||
61 | (defaction call-auto-complete-from-output ((auto-complete auto-complete) auto-complete-id value output) | |
62 | (setf (client-value auto-complete) value) | |
63 | (let ((self output)) | |
64 | (call (output-component auto-complete) :auto-complete auto-complete) | |
65 | (call 'empty-page :message (error "ASD")))) | |
66 | ||
67 | ||
68 | ||
69 | (defmethod js-on-select ((l auto-complete))) | |
70 | ||
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 | |
76 | ;; the input field. | |
77 | ||
78 | (unless (get-session-value input-key) | |
79 | (setf (get-session-value input-key) l)) | |
80 | ||
81 | ;; A hidden field to hold the index number selected via javascript | |
82 | (<ucw:input :type "hidden" | |
83 | :accessor (selected-value-index l) | |
84 | :id (index-id 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)))) | |
90 | (<ucw:script | |
91 | `(setf ,a | |
92 | (new | |
93 | (*Ajax.*Autocompleter | |
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*))) | |
98 | (create | |
99 | :param-name "value")))) | |
100 | `(setf ,f (slot-value ,a 'select-entry)) | |
101 | `(setf (slot-value ,a 'select-entry) | |
102 | (lambda () | |
103 | (,f) | |
104 | (setf (slot-value (document.get-element-by-id ,(index-id l)) 'value) | |
105 | (slot-value ,a 'index)) | |
106 | ,(js-on-select l) | |
107 | ))))) | |
108 | ||
109 | ||
110 | (defmethod find-selected-object ((self auto-complete)) | |
111 | (if (< 0 (length (selected-value-index self))) | |
112 | (nth (parse-integer (selected-value-index self)) | |
113 | (value-list self)))) | |
114 | ||
115 | ||
116 | ;;;; * auto-complete-ouput | |
117 | ||
118 | ||
119 | (defcomponent auto-complete-output (window-component) | |
120 | ((auto-complete :initarg :auto-complete :accessor auto-complete))) | |
121 | ||
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))) | |
126 | (<:ul | |
127 | :class "auto-complete-list" | |
128 | (arnesi:dolist* (value (value-list auto-complete)) | |
129 | (<:li | |
130 | :class "auto-complete-list-item" | |
131 | (funcall (render auto-complete) value)))))) | |
132 | ||
133 | ||
134 | (defcomponent fkey-auto-complete (auto-complete) | |
135 | ()) | |
136 | ||
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)))) | |
140 | ||
141 | (defslot-presentation ajax-foreign-key-slot-presentation (mewa::foreign-key-slot-presentation) | |
142 | ((search-slots :accessor search-slots :initarg :search-slots :initform nil) | |
143 | (live-search | |
144 | :accessor live-search | |
145 | :component fkey-auto-complete)) | |
146 | (:type-name ajax-foreign-key)) | |
147 | ||
148 | ||
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))) | |
159 | ||
160 | (setf (lisp-on-lines::values-generator l) | |
161 | (lambda (input) | |
162 | (word-search class-name | |
163 | (search-slots slot) input))) | |
164 | ||
165 | (setf (lisp-on-lines::render l) | |
166 | (lambda (val) | |
167 | (<ucw:render-component | |
168 | :component (make-presentation val :type :one-line)))))) | |
169 | ||
170 | ||
171 | ||
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) | |
178 | (cond | |
179 | ((editablep slot) | |
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)) | |
184 | (render))) | |
185 | (t | |
186 | (render))) | |
187 | ;; presentation is used only for rendering | |
188 | (render)))) |