3 (defclass lol-test-server
(standard-server)
6 (defclass lol-test-application
(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 (register-application *lol-test-ucw-server
* *lol-test-ucw-application
*)
30 (defentry-point "index.ucw" (:application
*lol-test-ucw-application
*) ()
31 (call 'lol-test-window
))
33 (defun startup-lol-ucw-test ()
34 (startup-server *lol-test-ucw-server
*))
36 (defun shutdown-lol-ucw-test ()
37 (shutdown-server *lol-test-ucw-server
*))
39 (defcomponent lol-test-window
(standard-window-component)
42 :body
(make-instance 'lol-test-suite-component
)))
44 (define-symbol-macro $window
(lol-ucw:context.window-component
*context
*))
46 (define-symbol-macro $body
(window-body $window
))
48 (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 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 (defcomponent lol-test-render
()
64 ((message :initform
"test" :accessor message
:initarg
:message
)))
66 (defmethod render ((self lol-test-render
))
67 (<:h3
:id
"test-render"
68 (<:as-html
(format nil
"Hello ~A." (message self
)))))
70 (defcomponent lol-test-simple-action
()
73 (defmethod 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 (defcomponent lol-test-answer
(lol-test-render) ()
120 (:default-initargs
:message
"CALL was ok. Go Back will answer"))
122 (defmethod render :wrapping
((self lol-test-answer
))
124 (<lol
:a
:action
(answer-component self nil
) "Go Back."))
126 (defcomponent lol-test-simple-form
(lol-test-render) ()
127 (:default-initargs
:message
"Testing Simple Form:"))
129 (defmethod render :wrapping
((self lol-test-simple-form
))
132 :action
(setf (message self
) "Form Submitted")
134 (<lol
:a
:action
(answer-component self nil
) "Go Back."))
136 (defcomponent lol-test-multi-submit-form
(lol-test-render) ()
137 (:default-initargs
:message
"Testing Simple Form:"))
139 (defmethod render :wrapping
((self lol-test-multi-submit-form
))
142 :action
(setf (message self
) "Form Submitted")
144 (<lol
:submit
:action
(setf (message self
) "Submit 2" )
146 (<lol
:submit
:action
(setf (message self
) "Submit 3")
148 (<lol
:a
:action
(answer-component self nil
) "Go Back."))
150 (defcomponent lol-test-input
(lol-test-render)
152 (:default-initargs
:message
"Testing INPUTS"))
154 (defmethod render :wrapping
((self lol-test-input
))
157 :function
(constantly t
)
158 (<lol
:input
:type
"text" :accessor
(message self
))
162 (<lol
:a
:action
(answer-component self nil
) "Go Back."))
166 (defcomponent lol-test-call-magic
(lol-test-render)
168 (:default-initargs
:message
"Testing CALL magic."))
170 (defmethod render :wrapping
((self lol-test-call-magic
))
172 (<lol
:a
:action
(setf (message self
) (call 'lol-test-answer-magic
)) "Test CALL")
174 (<lol
:a
:action
(answer-component self nil
) "Go Back."))
178 (defcomponent lol-test-answer-magic
(lol-test-render)
180 (:default-initargs
:message
"Hit it to answer"))
182 (defmethod render :wrapping
((self lol-test-answer-magic
))
185 (<lol
:a
:action
(answer "Ja, dat is vut ve answer" ) "IT! (hit here)"))
187 (defcomponent lol-test-call-answer-action-magic
(lol-test-render)
189 (:default-initargs
:message
"Hit it to answer"))
191 (defaction test-call-component
()
192 (call 'lol-test-call-answer-action-magic
:message
"We made it"))
194 (defaction test-answer-component
()
195 (answer "We Made IT BACK!!!"))
197 (defmethod render :wrapping
((self lol-test-call-answer-action-magic
))
199 (<lol
:a
:action
(test-call-component) "Test CALL from ACTION")
201 (<lol
:a
:action
(test-answer-component) "Test ANSWER from ACTION"))