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 (answer-component *source-component
*
30 (defclass described-component-class
(standard-component-class described-class
)
33 (defmacro defaction
(&rest args-and-body
)
34 `(arnesi:defmethod
/cc
,@args-and-body
))
36 (defparameter *default-action-class
* 'standard-basic-action
)
38 (defun make-action (lambda &rest initargs
&key
(class *default-action-class
*) &allow-other-keys
)
39 "Makes a new unregistered action."
40 (remf-keywords initargs
:class
)
41 (apply #'make-instance class
:lambda lambda initargs
))
44 (defclass standard-application
(ucw:basic-application
)
47 (defclass standard-request-context
(ucw::standard-request-context
)
50 (defmethod ucw:request-context-class list
((application standard-application
))
51 'standard-request-context
)
53 (defvar +action-compound-name-delimiter
+ #\|
)
55 (defmethod ucw::find-action-id
:around
((context standard-request-context
))
58 :for
(k . v
) in
(ucw::parameters
59 (context.request context
))
60 :do
(destructuring-bind (param-name &optional action-id
)
61 (split-sequence:split-sequence
62 +action-compound-name-delimiter
+ k
)
65 ucw
::+action-parameter-name
+ param-name
))
69 (defcomponent standard-window-component
70 (ucw:basic-window-component
)
77 (defmethod render-html-head ((window standard-window-component
))
78 (let* ((app (context.application
*context
*))
79 (url-prefix (application.url-prefix app
)))
80 (<:meta
:http-equiv
"Content-Type" :content
(window-component.content-type window
))
81 (awhen (window-component.title window
)
82 (<:title
(if (functionp it
)
85 (awhen (window-component.icon window
)
88 :href
(concatenate 'string url-prefix it
)))
89 (dolist (stylesheet (effective-window-stylesheets window
))
90 (<:link
:rel
"stylesheet"
94 (defmethod render-html-body ((window standard-window-component
))
95 (ucw:render
(window-body window
)))
97 (defcomponent info-message
()
98 ((message :accessor message
:initarg
:message
)))
100 (defmethod render ((m info-message
))
103 (<:as-html
(message m
)))
104 (<lol
:a
:action
(answer-component m nil
) "Ok"))