Commit | Line | Data |
---|---|---|
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 | ||
f56d6e7e | 47 | (defmethod ucw-core:handle-action :wrap-around ((action lisp-on-lines-action) application session frame) |
e8fd1a9a | 48 | (let ((lol::*invalid-objects* (make-hash-table))) |
49 | (handler-bind ((lol::validation-condition | |
50 | (lambda (c) | |
51 | (let ((object (lol::validation-condition-object c)) | |
52 | (attribute (lol::validation-condition-attribute c))) | |
b7657b86 | 53 | |
b7657b86 | 54 | |
e8fd1a9a | 55 | (setf (gethash object lol::*invalid-objects*) |
56 | (cons (cons attribute c) | |
57 | (gethash object lol::*invalid-objects*))))))) | |
58 | (call-next-method)))) | |
b7657b86 | 59 | |
7dd8b225 CE |
60 | (defclass described-component-class (described-class standard-component-class) |
61 | ()) | |
62 | ||
63 | ||
4358148e | 64 | |
4358148e | 65 | |
4358148e | 66 | |
4358148e | 67 | |
4358148e | 68 | |
4358148e | 69 | |
2548f054 | 70 | |
71 | ||
72 | ||
73 | ||
46440824 | 74 | ;; (defcomponent standard-window-component |
75 | ;; (ucw-standard::basic-window-component) | |
76 | ;; ((body | |
77 | ;; :initform nil | |
78 | ;; :accessor window-body | |
79 | ;; :component t | |
80 | ;; :initarg :body))) | |
81 | ||
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) | |
89 | ;; (<:as-html it)))) | |
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" | |
96 | ;; :href stylesheet | |
97 | ;; :type "text/css")))) | |
98 | ||
99 | ;; (defmethod render-html-body ((window standard-window-component)) | |
100 | ;; (render (window-body window))) | |
101 | ||
102 | ;; (defcomponent info-message () | |
103 | ;; ((message :accessor message :initarg :message))) | |
104 | ||
105 | ;; (defmethod render ((m info-message)) | |
106 | ;; (<:div | |
107 | ;; :class "info-mssage" | |
108 | ;; (<:as-html (message m))) | |
109 | ;; (<ucw:a :action (answer-component m nil) "Ok")) | |
b7657b86 | 110 | |
111 |