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