1 (in-package :lisp-on-lines-ucw
)
3 (defclass lisp-on-lines-action
(ucw-standard::standard-action
)
4 ((layer-context :accessor action-layer-context
6 :initarg
:layer-context
))
7 (:metaclass closer-mop
:funcallable-standard-class
))
10 (setf ucw-standard
::*default-action-class
* 'lisp-on-lines-action
)
14 (defmethod ucw-core:call-action
:around
((action lisp-on-lines-action
) application session frame
)
15 (let ((next-method (lambda ()
17 action application session frame
19 (call-next-method))))))
20 (let ((layer-context (action-layer-context action
)))
22 (funcall-with-layer-context layer-context next-method
)
23 (funcall next-method
)))
26 (defmethod ucw-core:handle-action
:around
((action lisp-on-lines-action
) application session frame
)
27 (let ((lol::*invalid-objects
* (make-hash-table)))
28 (handler-bind ((lol::validation-condition
30 (let ((object (lol::validation-condition-object c
))
31 (attribute (lol::validation-condition-attribute c
)))
34 (setf (gethash object lol
::*invalid-objects
*)
35 (cons (cons attribute c
)
36 (gethash object lol
::*invalid-objects
*)))))))
40 (define-layered-function layered-call-action
(action application session frame next-method
)
41 (:method
(action application session frame next-method
)
42 (funcall next-method
)))
45 (contextl:define-layered-method layered-call-action
46 :in-layer
#.
(lol::defining-description
'lol
::validate
)
47 :around
((action lisp-on-lines-action
) application session frame next-method
)
54 (defclass described-component-class
(described-class standard-component-class
)
59 (defcomponent standard-window-component
60 (ucw-standard::basic-window-component
)
67 (defmethod render-html-head ((window standard-window-component
))
68 (let* ((app (context.application
*context
*))
69 (url-prefix (application.url-prefix app
)))
70 (<:meta
:http-equiv
"Content-Type" :content
(window-component.content-type window
))
71 (awhen (window-component.title window
)
72 (<:title
(if (functionp it
)
75 (awhen (window-component.icon window
)
78 :href
(concatenate 'string url-prefix it
)))
79 (dolist (stylesheet (effective-window-stylesheets window
))
80 (<:link
:rel
"stylesheet"
84 (defmethod render-html-body ((window standard-window-component
))
85 (render (window-body window
)))
87 (defcomponent info-message
()
88 ((message :accessor message
:initarg
:message
)))
90 (defmethod render ((m info-message
))
93 (<:as-html
(message m
)))
94 (<lol
:a
:action
(answer-component m nil
) "Ok"))