Drop usage of defaction
[clinton/lisp-on-lines.git] / src / attributes / dojo-attributes.lisp
1 (in-package :lisp-on-lines)
2
3 (deflayer dojo)
4
5 #+nil(define-layered-class
6 description :in-layer dojo ()
7 ((dojo-type :accessor dojo-type :initarg :dojo-type :initform nil :special t)))
8
9 (define-layered-function display-as-dojo-type (type description object component))
10
11 (defdisplay
12 :in-layer dojo :after (description object)
13 (when (dojo-type description)
14 (display-as-dojo-type (dojo-type description) description object self)))
15
16 (defcomponent combo-results ()
17 ())
18
19 (defmethod render ((self combo-results))
20 (<:as-is (js:js* `(array
21 ,@(loop for r in (results self)
22 for n upfrom 0
23 collect `(array ,
24 (with-output-to-string (s)
25 (yaclml:with-yaclml-stream s
26 (display self r :type 'as-string)))
27 ,n))))))
28
29
30 (define-layered-method display-as-dojo-type ((type (eql 'combo-box)) attribute object component)
31
32 (let* ((search-function (search-function attribute))
33 (select-function (select-function attribute))
34 (select-callback (ucw::make-new-callback
35 (lambda (x)
36 (funcall select-function
37 (parse-integer x))))))
38 "The combo box widget"
39 (<ucw:script
40 `(dojo.require "dojo.*")
41 `(dojo.require "dojo.widget.*")
42 `(dojo.require "dojo.widget.html.ComboBox")
43 (js:with-unique-js-names (element combo-box)
44
45 `(dojo.add-on-load
46 (lambda ()
47 (setf ,element (dojo.by-id ,(id attribute)))
48 (setf ,combo-box
49 (dojo.widget.from-script
50 "ComboBox"
51 (create
52 :data-url (+ , (lol::make-action-url
53 component
54 (call-component
55 (context.window-component *context*)
56 (make-instance 'combo-results
57 :results
58 (funcall search-function
59 (attribute-value object attribute)))))
60 "&"
61 ,(escape-as-uri (callback attribute))
62 "=%{searchString}")
63 :mode "remote")
64 ,element))
65 ((slot-value ,combo-box 'set-value) (slot-value ,element 'value))
66 (dojo.event.connect
67 ,combo-box "selectOption"
68 (lambda ()
69 (setf (slot-value ,element 'value)
70 (slot-value ,combo-box 'selected-result))
71 (dojo.io.bind
72 (create
73 :url (+ ,(lol::make-action-url
74 component
75 nil)
76 "&"
77 ,(escape-as-uri (callback attribute))
78 "="
79 (slot-value ,combo-box 'selected-result)
80 "&"
81 ,select-callback
82 "="
83 (slot-value ,combo-box 'combo-box-selection-value.value))))))))))))
84