1 (in-package :lisp-on-lines-ucw
)
3 (defmacro dlambda
((&rest args
) &body body
)
5 `(let ((,env
(capture-dynamic-environment)))
7 (with-dynamic-environment (,env
)
10 (export '(dlambda) :lisp-on-lines-ucw
)
12 (defclass contextl-application
(standard-application)
16 :action-class
'contextl-action
))
18 (defclass contextl-action
(ucw-standard:standard-action
)
19 ((dynamic-environment :accessor action-dynamic-environment
21 :initarg
:dynamic-environment
))
22 (:metaclass closer-mop
:funcallable-standard-class
))
24 (defmethod shared-initialize :after
((action contextl-action
) slots
&rest args
)
25 (declare (ignore slots args
))
26 (setf (action-dynamic-environment action
) (capture-dynamic-environment)))
28 (defmethod ucw-core:handle-action
:wrap-around
((action contextl-action
) application session frame
)
31 (defmethod ucw-core:call-action
:around
((action contextl-action
) application session frame
)
32 (with-dynamic-environment ((action-dynamic-environment action
))
35 (defmethod ucw-core:call-callbacks
:around
((action contextl-action
) frame request
)
36 (with-dynamic-environment ((action-dynamic-environment action
))
40 (defclass contextl-component
(standard-component)
41 ((component-dynamic-environment :accessor component-dynamic-environment
43 (:metaclass standard-component-class
))
45 (defmethod render :wrap-around
((component contextl-component
))
46 (if (component-dynamic-environment component
)
47 (with-dynamic-environment ((component-dynamic-environment component
))
49 (progn (setf (component-dynamic-environment component
) (capture-dynamic-environment))
52 (defmethod/cc call-component
:before
((from t
) (to contextl-component
))
53 (setf (component-dynamic-environment to
) (capture-dynamic-environment)))
59 (defclass contextl-test-application
(contextl-application)
61 (:default-initargs
:url-prefix
"/contextl/"))
63 (defparameter *context-test-application
* (make-instance 'contextl-test-application
))
65 (register-application ucw-user
:*example-server
* *context-test-application
*)
67 (defentry-point "test.ucw" (:application
*context-test-application
*) ()
68 (call 'contextl-test-component
))
72 (defclass contextl-test-component
(contextl-component) ()
73 (:metaclass standard-component-class
))
75 (defmethod render ((component contextl-test-component
))
76 (<:As-html
(dynamic foo
))
77 (dlet ((foo (1+ (dynamic foo
))))
78 (<:as-html
(dynamic foo
))
80 (with-described-object (T nil
)
81 (let ((a (find-attribute *description
* 'identity
)))
82 (<ucw
:a
:action
(call 'contextl-test-component
)
85 (when (component.calling-component component
)
86 (<ucw
:a
:action
(answer)
105 #+nil
(defclass contextl-session-frame
(ucw-core::standard-session-frame
)
108 #+nil
(defmethod ucw-core::register-callback-in-frame
((frame contextl-session-frame
) callback
&key
&allow-other-keys
)
109 (let ((lambda (ucw::callback-lambda callback
)))
110 (let ((context (contextl:current-layer-context
)))
111 (setf (ucw::callback-lambda callback
)
113 (contextl:funcall-with-layer-context context lambda arg
)))
114 (call-next-method))))
116 #+nil
(setf ucw-core
::*session-frame-class
* 'contextl-session-frame
)