1 (in-package :lisp-on-lines-ucw
)
3 (defclass lisp-on-lines-application
(contextl-application)
5 (:default-initargs
:action-class
'lisp-on-lines-action
))
7 (defclass lisp-on-lines-action
(action-with-isolation-support contextl-action
)
9 (:metaclass closer-mop
:funcallable-standard-class
))
11 (defclass lisp-on-lines-component
(contextl-component)
13 (:metaclass standard-component-class
))
15 (defclass lisp-on-lines-component-class
(standard-component-class)
19 (defmethod initialize-instance :around
((class lisp-on-lines-component-class
)
20 &rest initargs
&key
(direct-superclasses '()))
21 (declare (dynamic-extent initargs
))
22 (if (loop for direct-superclass in direct-superclasses
23 thereis
(ignore-errors (subtypep direct-superclass
'lisp-on-lines-component
)))
25 (apply #'call-next-method
28 (append direct-superclasses
29 (list (find-class 'lisp-on-lines-component
)))
33 (defmethod reinitialize-instance :around
((class lisp-on-lines-component-class
)
34 &rest initargs
&key
(direct-superclasses '() direct-superclasses-p
))
35 (declare (dynamic-extent initargs
))
36 (if (or (not direct-superclasses-p
)
37 (loop for direct-superclass in direct-superclasses
38 thereis
(ignore-errors (subtypep direct-superclass
'lisp-on-lines-component
))))
40 (apply #'call-next-method
43 (append direct-superclasses
44 (list (find-class 'lisp-on-lines-component
)))
47 (defmethod ucw-core:handle-action
:wrap-around
((action lisp-on-lines-action
) application session frame
)
48 (let ((lol::*invalid-objects
* (make-hash-table)))
49 (handler-bind ((lol::validation-condition
51 (let ((object (lol::validation-condition-object c
))
52 (attribute (lol::validation-condition-attribute c
)))
55 (setf (gethash object lol
::*invalid-objects
*)
56 (cons (cons attribute c
)
57 (gethash object lol
::*invalid-objects
*)))))))
60 (defclass described-component-class
(described-class standard-component-class
)
74 ;; (defcomponent standard-window-component
75 ;; (ucw-standard::basic-window-component)
78 ;; :accessor window-body
82 ;; (defmethod render-html-head ((window standard-window-component))
83 ;; (let* ((app (context.application *context*))
84 ;; (url-prefix (application.url-prefix app)))
85 ;; (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
86 ;; (awhen (window-component.title window)
87 ;; (<:title (if (functionp it)
88 ;; (funcall it window)
90 ;; (awhen (window-component.icon window)
91 ;; (<:link :rel "icon"
92 ;; :type "image/x-icon"
93 ;; :href (concatenate 'string url-prefix it)))
94 ;; (dolist (stylesheet (effective-window-stylesheets window))
95 ;; (<:link :rel "stylesheet"
97 ;; :type "text/css"))))
99 ;; (defmethod render-html-body ((window standard-window-component))
100 ;; (render (window-body window)))
102 ;; (defcomponent info-message ()
103 ;; ((message :accessor message :initarg :message)))
105 ;; (defmethod render ((m info-message))
107 ;; :class "info-mssage"
108 ;; (<:as-html (message m)))
109 ;; (<ucw:a :action (answer-component m nil) "Ok"))