1 (in-package :lisp-on-lines-ucw
)
3 (defparameter *source-component
* nil
)
5 (defclass standard-basic-action
(basic-action)
6 ((source-component :accessor action-source-component
))
7 (:metaclass mopp
:funcallable-standard-class
))
9 (defmethod shared-initialize :before
((action standard-basic-action
) slots
&rest args
)
10 (declare (ignore slots args
))
11 (setf (action-source-component action
) *source-component
*))
13 (defmethod handle-action :around
((action standard-basic-action
) a s f
)
14 (let ((*source-component
* (action-source-component action
)))
17 (defmethod render :around
(component)
18 (let ((*source-component
* component
))
22 (defun/cc call
(name &rest args
)
23 (call-component *source-component
*
24 (apply #'make-instance name args
)))
26 (defun/cc answer
(&optional val
)
27 (let ((child *source-component
*))
28 (setf *source-component
* (ucw::component.calling-component child
))
29 (answer-component child val
)))
31 (defclass described-component-class
(described-class standard-component-class
)
34 (defmacro defaction
(&rest args-and-body
)
35 `(arnesi:defmethod
/cc
,@args-and-body
))
37 (defparameter *default-action-class
* 'standard-basic-action
)
39 (defun make-action (lambda &rest initargs
&key
(class *default-action-class
*) &allow-other-keys
)
40 "Makes a new unregistered action."
41 (remf-keywords initargs
:class
)
42 (apply #'make-instance class
:lambda lambda initargs
))
45 (defclass standard-application
(ucw:basic-application
)
48 (defclass standard-request-context
(ucw::standard-request-context
)
51 (defmethod ucw:request-context-class list
((application standard-application
))
52 'standard-request-context
)
54 (defvar +action-compound-name-delimiter
+ #\|
)
56 (defmethod ucw::find-action-id
:around
((context standard-request-context
))
59 :for
(k . v
) in
(ucw::parameters
60 (context.request context
))
61 :do
(destructuring-bind (param-name &optional action-id
)
62 (split-sequence:split-sequence
63 +action-compound-name-delimiter
+ k
)
66 ucw
::+action-parameter-name
+ param-name
))
74 (defcomponent standard-window-component
75 (ucw::basic-window-component
)
82 (defmethod render-html-head ((window standard-window-component
))
83 (let* ((app (context.application
*context
*))
84 (url-prefix (application.url-prefix app
)))
85 (<:meta
:http-equiv
"Content-Type" :content
(window-component.content-type window
))
86 (awhen (window-component.title window
)
87 (<:title
(if (functionp it
)
90 (awhen (window-component.icon window
)
93 :href
(concatenate 'string url-prefix it
)))
94 (dolist (stylesheet (effective-window-stylesheets window
))
95 (<:link
:rel
"stylesheet"
99 (defmethod render-html-body ((window standard-window-component
))
100 (ucw:render
(window-body window
)))
102 (defcomponent info-message
()
103 ((message :accessor message
:initarg
:message
)))
105 (defmethod render ((m info-message
))
108 (<:as-html
(message m
)))
109 (<lol
:a
:action
(answer-component m nil
) "Ok"))