Pass &rest args onto next method in display t NULL
[clinton/lisp-on-lines.git] / src / ucw / standard-components.lisp
CommitLineData
4358148e 1(in-package :lisp-on-lines-ucw)
2
6963098f 3(defclass lisp-on-lines-application (contextl-application)
4 ()
5 (:default-initargs :action-class 'lisp-on-lines-action))
6
8032a7fe 7(defclass lisp-on-lines-action (action-with-isolation-support contextl-action )
6963098f 8 ()
e8fd1a9a 9 (:metaclass closer-mop:funcallable-standard-class))
b7657b86 10
6963098f 11(defclass lisp-on-lines-component (contextl-component)
12 ()
13 (:metaclass standard-component-class))
14
15(defclass lisp-on-lines-component-class (standard-component-class)
16 ())
17
18
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)))
24 (call-next-method)
25 (apply #'call-next-method
26 class
27 :direct-superclasses
28 (append direct-superclasses
29 (list (find-class 'lisp-on-lines-component)))
30 initargs)))
31
32
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))))
39 (call-next-method)
40 (apply #'call-next-method
41 class
42 :direct-superclasses
43 (append direct-superclasses
44 (list (find-class 'lisp-on-lines-component)))
45 initargs)))
46
47(defclass described-component-class (described-class standard-component-class )
48 ())
b7657b86 49
b7657b86 50
b7657b86 51
b7657b86 52
f56d6e7e 53(defmethod ucw-core:handle-action :wrap-around ((action lisp-on-lines-action) application session frame)
e8fd1a9a 54 (let ((lol::*invalid-objects* (make-hash-table)))
55 (handler-bind ((lol::validation-condition
56 (lambda (c)
57 (let ((object (lol::validation-condition-object c))
58 (attribute (lol::validation-condition-attribute c)))
b7657b86 59
b7657b86 60
e8fd1a9a 61 (setf (gethash object lol::*invalid-objects*)
62 (cons (cons attribute c)
63 (gethash object lol::*invalid-objects*)))))))
64 (call-next-method))))
b7657b86 65
4358148e 66
4358148e 67
4358148e 68
4358148e 69
4358148e 70
4358148e 71
2548f054 72
e8fd1a9a 73(defclass described-component-class (described-class standard-component-class )
74 ())
2548f054 75
76
77
46440824 78;; (defcomponent standard-window-component
79;; (ucw-standard::basic-window-component)
80;; ((body
81;; :initform nil
82;; :accessor window-body
83;; :component t
84;; :initarg :body)))
85
86;; (defmethod render-html-head ((window standard-window-component))
87;; (let* ((app (context.application *context*))
88;; (url-prefix (application.url-prefix app)))
89;; (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
90;; (awhen (window-component.title window)
91;; (<:title (if (functionp it)
92;; (funcall it window)
93;; (<:as-html it))))
94;; (awhen (window-component.icon window)
95;; (<:link :rel "icon"
96;; :type "image/x-icon"
97;; :href (concatenate 'string url-prefix it)))
98;; (dolist (stylesheet (effective-window-stylesheets window))
99;; (<:link :rel "stylesheet"
100;; :href stylesheet
101;; :type "text/css"))))
102
103;; (defmethod render-html-body ((window standard-window-component))
104;; (render (window-body window)))
105
106;; (defcomponent info-message ()
107;; ((message :accessor message :initarg :message)))
108
109;; (defmethod render ((m info-message))
110;; (<:div
111;; :class "info-mssage"
112;; (<:as-html (message m)))
113;; (<ucw:a :action (answer-component m nil) "Ok"))
b7657b86 114
115