-(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)))
+(in-package :lisp-on-lines-ucw)
+
+(defclass lisp-on-lines-action (ucw-standard::standard-action)
+ ((layer-context :accessor action-layer-context
+ :initform nil
+ :initarg :layer-context))
+ (:metaclass closer-mop:funcallable-standard-class))
+
+
+(setf ucw-standard::*default-action-class* 'lisp-on-lines-action)
+
+
+
+(defmethod ucw-core:call-action :around ((action lisp-on-lines-action) application session frame)
+ (let ((next-method (lambda ()
+ (layered-call-action
+ action application session frame
+ (lambda ()
+ (call-next-method))))))
+ (let ((layer-context (action-layer-context action)))
+ (if layer-context
+ (funcall-with-layer-context layer-context next-method)
+ (funcall next-method)))
+ ))
+
+(defmethod ucw-core:handle-action :around ((action lisp-on-lines-action) application session frame)
+ (let ((lol::*invalid-objects* (make-hash-table)))
+ (handler-bind ((lol::validation-condition
+ (lambda (c)
+ (let ((object (lol::validation-condition-object c))
+ (attribute (lol::validation-condition-attribute c)))
+
+
+ (setf (gethash object lol::*invalid-objects*)
+ (cons (cons attribute c)
+ (gethash object lol::*invalid-objects*)))))))
+ (call-next-method))))
+
+
+(define-layered-function layered-call-action (action application session frame next-method)
+ (:method (action application session frame next-method)
+ (funcall next-method)))
+
+
+(contextl:define-layered-method layered-call-action
+ :in-layer #.(lol::defining-description 'lol::validate)
+ :around ((action lisp-on-lines-action) application session frame next-method)
+ (call-next-method)
+
+ )
+
+
+
+(defclass described-component-class (described-class standard-component-class )
+ ())
+
+
+
+(defcomponent standard-window-component
+ (ucw-standard::basic-window-component)
+ ((body
+ :initform nil
+ :accessor window-body
+ :component t
+ :initarg :body)))
+
+(defmethod render-html-head ((window standard-window-component))
+ (let* ((app (context.application *context*))
+ (url-prefix (application.url-prefix app)))
+ (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
+ (awhen (window-component.title window)
+ (<:title (if (functionp it)
+ (funcall it window)
+ (<:as-html it))))
+ (awhen (window-component.icon window)
+ (<:link :rel "icon"
+ :type "image/x-icon"
+ :href (concatenate 'string url-prefix it)))
+ (dolist (stylesheet (effective-window-stylesheets window))
+ (<:link :rel "stylesheet"
+ :href stylesheet
+ :type "text/css"))))
+
+(defmethod render-html-body ((window standard-window-component))
+ (render (window-body window)))
+
+(defcomponent info-message ()
+ ((message :accessor message :initarg :message)))
+
+(defmethod render ((m info-message))
+ (<:div
+ :class "info-mssage"
+ (<:as-html (message m)))
+ (<lol:a :action (answer-component m nil) "Ok"))
+
+