3 (defclass lol-test-server
(ucw-core:standard-server
)
6 (defclass lol-test-application
(ucw:standard-application
)
9 :url-prefix
"/lisp-on-lines.test/"
10 ; :www-roots (list (cons "static/" (project-relative-pathname #P"wwwroot/")))
13 (defparameter *lol-test-ucw-application
* (make-instance 'lol-test-application
))
15 (defun make-backend ()
24 :backend
(make-backend)))
26 (defparameter *lol-test-ucw-server
* (make-server))
28 (ucw-core:register-application
*lol-test-ucw-server
* *lol-test-ucw-application
*)
30 (ucw-core:defentry-point
"index.ucw" (:application
*lol-test-ucw-application
*) ()
31 (call 'lol-test-window
))
33 (defun startup-lol-ucw-test ()
34 (ucw-core:startup-server
*lol-test-ucw-server
*))
36 (defun shutdown-lol-ucw-test ()
37 (ucw-core:shutdown-server
*lol-test-ucw-server
*))
39 (ucw-core:defcomponent lol-test-window
(standard-window-component)
42 :body
(make-instance 'lol-test-suite-component
)))
44 (define-symbol-macro $window
(ucw-core:context.window-component
*context
*))
46 (define-symbol-macro $body
(window-body $window
))
48 (ucw-core:defcomponent lol-test-suite-component
()
49 ((test :component lol-test-simple-action
:accessor test
)
50 (component :component lol-test-render
:accessor component
)))
52 (define-symbol-macro $test
(test $body
))
54 (define-symbol-macro $component
(component $body
))
56 (defmethod ucw-core:render
((self lol-test-suite-component
))
57 (<:H1
"Lisp On Lines Web test suite")
58 (render (slot-value self
'test
))
60 :style
"border:1px solid black;"
61 (render (slot-value self
'component
))))
63 (ucw-core:defcomponent lol-test-render
()
64 ((message :initform
"test" :accessor message
:initarg
:message
)))
66 (defmethod ucw-core:render
((self lol-test-render
))
67 (<:h3
:id
"test-render"
68 (<:as-html
(format nil
"Hello ~A." (message self
)))))
70 (ucw-core:defcomponent lol-test-simple-action
()
73 (defmethod ucw-core:render
((self lol-test-simple-action
))
78 (setf (message $component
)
79 (format nil
"~A : ~A" (message $component
) "FUNCTION")))
80 "Test <:A :FUNCTION type actions"))
83 :action
(setf (message $component
)
84 (format nil
"~A : ~A" (message $component
) "ACTION"))
85 "Test <:A :ACTION type actions"))
90 (setf (message $component
)
91 (format nil
"~A : ~A" (message $component
) "ACTION*"))))
92 "Test <:A :ACTION* type actions"))
95 :action
(call-component $component
(make-instance 'lol-test-answer
))
96 "Test CALL-COMPONENT/ANSWER-COMPONENT"))
99 :action
(call-component $component
(make-instance 'lol-test-call-magic
))
100 "Test CALL/ANSWER MAGIC"))
103 :action
(call-component $component
(make-instance 'lol-test-call-answer-action-magic
))
104 "Test CALL/ANSWER ACTION MAGIC"))
107 :action
(call-component $component
(make-instance 'lol-test-simple-form
))
111 :action
(call-component $component
(make-instance 'lol-test-multi-submit-form
))
115 :action
(call-component $component
(make-instance 'lol-test-input
))
119 (ucw-core:defcomponent lol-test-answer
(lol-test-render) ()
120 (:default-initargs
:message
"CALL was ok. Go Back will answer"))
122 (defmethod ucw-core:render
:wrapping
((self lol-test-answer
))
124 (<ucw
:a
:action
(answer-component self nil
) "Go Back."))
126 (ucw-core:defcomponent lol-test-simple-form
(lol-test-render) ()
127 (:default-initargs
:message
"Testing Simple Form:"))
129 (defmethod ucw-core:render
:wrapping
((self lol-test-simple-form
))
132 :action
(setf (message self
) "Form Submitted")
134 (<ucw
:a
:action
(answer-component self nil
) "Go Back."))
136 (ucw-core:defcomponent lol-test-multi-submit-form
(lol-test-render) ()
137 (:default-initargs
:message
"Testing Simple Form:"))
139 (defmethod ucw-core:render
:wrapping
((self lol-test-multi-submit-form
))
142 :action
(setf (message self
) "Form Submitted")
144 (<ucw
:submit
:action
(setf (message self
) "Submit 2" )
146 (<ucw
:submit
:action
(setf (message self
) "Submit 3")
148 (<ucw
:a
:action
(answer-component self nil
) "Go Back."))
150 (ucw-core:defcomponent lol-test-input
(lol-test-render)
152 (:default-initargs
:message
"Testing INPUTS"))
154 (defmethod ucw-core:render
:wrapping
((self lol-test-input
))
157 :function
(constantly t
)
158 (<ucw
:input
:type
"text" :accessor
(message self
))
162 (<ucw
:a
:action
(answer-component self nil
) "Go Back."))
166 (ucw-core:defcomponent lol-test-call-magic
(lol-test-render)
168 (:default-initargs
:message
"Testing CALL magic."))
170 (defmethod ucw-core:render
:wrapping
((self lol-test-call-magic
))
172 (<ucw
:a
:action
(setf (message self
) (call 'lol-test-answer-magic
)) "Test CALL")
174 (<ucw
:a
:action
(answer-component self nil
) "Go Back."))
178 (ucw-core:defcomponent lol-test-answer-magic
(lol-test-render)
180 (:default-initargs
:message
"Hit it to answer"))
182 (defmethod ucw-core:render
:wrapping
((self lol-test-answer-magic
))
185 (<ucw
:a
:action
(answer "Ja, dat is vut ve answer" ) "IT! (hit here)"))
187 (ucw-core:defcomponent lol-test-call-answer-action-magic
(lol-test-render)
189 (:default-initargs
:message
"Hit it to answer"))
191 (ucw:defaction test-call-component
()
192 (call 'lol-test-call-answer-action-magic
:message
"We made it"))
194 (ucw:defaction test-answer-component
()
195 (answer "We Made IT BACK!!!"))
197 (defmethod ucw-core:render
:wrapping
((self lol-test-call-answer-action-magic
))
199 (<ucw
:a
:action
(test-call-component) "Test CALL from ACTION")
201 (<ucw
:a
:action
(test-answer-component) "Test ANSWER from ACTION"))