1 (in-package :lisp-on-lines-ucw
)
3 (defclass contextl-application
(standard-application)
7 :action-class
'contextl-action
))
9 (defclass contextl-action
(ucw-standard:standard-action
)
10 ((dynamic-environment :accessor action-dynamic-environment
12 :initarg
:dynamic-environment
))
13 (:metaclass closer-mop
:funcallable-standard-class
))
15 (defmethod shared-initialize :after
((action contextl-action
) slots
&rest args
)
16 (declare (ignore slots args
))
17 (setf (action-dynamic-environment action
) (capture-dynamic-environment)))
19 (defmethod ucw-core:handle-action
:wrap-around
((action contextl-action
) application session frame
)
22 (defmethod ucw-core:call-action
:around
((action contextl-action
) application session frame
)
23 (with-dynamic-environment ((action-dynamic-environment action
))
26 (defmethod ucw-core:call-callbacks
((action contextl-action
) frame request
)
27 (with-dynamic-environment ((action-dynamic-environment action
))
30 (defclass contextl-component
(standard-component)
31 ((component-dynamic-environment :accessor component-dynamic-environment
33 (:metaclass standard-component-class
))
35 (defmethod render :wrap-around
((component contextl-component
))
36 (if (component-dynamic-environment component
)
37 (with-dynamic-environment ((component-dynamic-environment component
))
39 (progn (setf (component-dynamic-environment component
) (capture-dynamic-environment))
42 (defmethod/cc call-component
:before
((from t
) (to contextl-component
))
43 (setf (component-dynamic-environment to
) (capture-dynamic-environment)))
49 (defclass contextl-test-application
(contextl-application)
51 (:default-initargs
:url-prefix
"/contextl/"))
53 (defparameter *context-test-application
* (make-instance 'contextl-test-application
))
55 (register-application ucw-user
:*example-server
* *context-test-application
*)
57 (defentry-point "test.ucw" (:application
*context-test-application
*) ()
58 (call 'contextl-test-component
))
62 (defclass contextl-test-component
(contextl-component) ()
63 (:metaclass standard-component-class
))
65 (defmethod render ((component contextl-test-component
))
66 (<:As-html
(dynamic foo
))
67 (dlet ((foo (1+ (dynamic foo
))))
68 (<:as-html
(dynamic foo
))
70 (with-described-object (T nil
)
71 (let ((a (find-attribute *description
* 'identity
)))
72 (<ucw
:a
:action
(call 'contextl-test-component
)
75 (when (component.calling-component component
)
76 (<ucw
:a
:action
(answer)
95 #+nil
(defclass contextl-session-frame
(ucw-core::standard-session-frame
)
98 #+nil
(defmethod ucw-core::register-callback-in-frame
((frame contextl-session-frame
) callback
&key
&allow-other-keys
)
99 (let ((lambda (ucw::callback-lambda callback
)))
100 (let ((context (contextl:current-layer-context
)))
101 (setf (ucw::callback-lambda callback
)
103 (contextl:funcall-with-layer-context context lambda arg
)))
104 (call-next-method))))
106 #+nil
(setf ucw-core
::*session-frame-class
* 'contextl-session-frame
)