Move initialization of attribute object
[clinton/lisp-on-lines.git] / src / ucw / standard-components.lisp
CommitLineData
4358148e 1(in-package :lisp-on-lines-ucw)
2
3(defmacro defaction (&rest args-and-body)
4 `(arnesi:defmethod/cc ,@args-and-body))
5
6(defun make-action (lambda &rest args)
7 (let ((ucw::*default-action-class* 'basic-action))
8 (apply #'ucw::make-action lambda args)))
9
10(defclass standard-application (ucw:basic-application)
11 ())
12
13(defclass standard-request-context (ucw::standard-request-context)
14 ())
15
16(defmethod ucw:request-context-class list ((application standard-application))
17 'standard-request-context)
18
19(defvar +action-compound-name-delimiter+ #\|)
20
21(defmethod ucw::find-action-id :around ((context standard-request-context))
22 (or
23 (let (id)
24 (ucw::find-parameter
25 (context.request context) ucw::+action-parameter-name+
26 :test (lambda (name parameter)
27 (declare (ignore name))
28 (destructuring-bind (param-name &optional action-id)
29 (split-sequence:split-sequence
30 +action-compound-name-delimiter+ parameter)
31 (when (and action-id
32 (string= ucw::+action-parameter-name+ param-name))
33 (setf id action-id)))))
34 id)
35 (call-next-method)))
36
37(defcomponent standard-window-component
38 (ucw:basic-window-component)
39 ((body
40 :initform nil
41 :accessor window-body
42 :component t
43 :initarg :body)))
44
45(defmethod ucw:render-html-body ((window standard-window-component))
46 (ucw:render (window-body window)))