Added standard descriptions and UCW integration.

[clinton/lisp-on-lines.git] / src / ucw / standard-components.lisp

diff --git a/src/ucw/standard-components.lisp b/src/ucw/standard-components.lisp
new file mode 100644 (file)
index 0000000..1dabaa4
--- /dev/null
+++ b/src/ucw/standard-components.lisp
@@ -0,0 +1,46 @@
+(in-package :lisp-on-lines-ucw)
+
+(defmacro defaction (&rest args-and-body)
+  `(arnesi:defmethod/cc ,@args-and-body))
+
+(defun make-action (lambda &rest args)
+  (let ((ucw::*default-action-class* 'basic-action))
+    (apply #'ucw::make-action lambda args)))
+
+(defclass standard-application (ucw:basic-application)
+  ())
+
+(defclass standard-request-context (ucw::standard-request-context)
+  ())
+
+(defmethod ucw:request-context-class list ((application standard-application))
+  'standard-request-context)
+
+(defvar +action-compound-name-delimiter+ #\|)
+
+(defmethod ucw::find-action-id :around ((context standard-request-context))
+  (or 
+   (let (id)
+     (ucw::find-parameter 
+      (context.request context) ucw::+action-parameter-name+
+      :test (lambda (name parameter)
+             (declare (ignore name))
+             (destructuring-bind (param-name &optional action-id)
+                 (split-sequence:split-sequence 
+                  +action-compound-name-delimiter+ parameter)
+               (when (and action-id 
+                          (string= ucw::+action-parameter-name+ param-name))
+                 (setf id action-id)))))
+     id)
+   (call-next-method)))
+
+(defcomponent standard-window-component 
+  (ucw:basic-window-component)
+  ((body
+    :initform nil
+    :accessor window-body
+    :component t
+    :initarg :body)))
+
+(defmethod ucw:render-html-body ((window standard-window-component))
+  (ucw:render (window-body window)))