tons of small changes to bring this up to date with maxclaims 2.0
[clinton/lisp-on-lines.git] / src / ucw / standard-components.lisp
... / ...
CommitLineData
1(in-package :lisp-on-lines-ucw)
2
3(defclass lisp-on-lines-action (ucw-standard::standard-action)
4 ((layer-context :accessor action-layer-context
5 :initform nil
6 :initarg :layer-context))
7 (:metaclass closer-mop:funcallable-standard-class))
8
9
10(setf ucw-core::*default-action-class* 'lisp-on-lines-action)
11
12
13(defmethod ucw-core:call-action :around ((action lisp-on-lines-action) application session frame)
14 (let ((next-method (lambda ()
15 (layered-call-action
16 action application session frame
17 (lambda ()
18 (call-next-method))))))
19 (let ((layer-context (action-layer-context action)))
20 (if layer-context
21 (contextl:funcall-with-layer-context layer-context next-method)
22 (funcall next-method)))
23 ))
24
25(defmethod ucw-core:handle-action :wrap-around ((action lisp-on-lines-action) application session frame)
26 (let ((lol::*invalid-objects* (make-hash-table)))
27 (handler-bind ((lol::validation-condition
28 (lambda (c)
29 (let ((object (lol::validation-condition-object c))
30 (attribute (lol::validation-condition-attribute c)))
31
32
33 (setf (gethash object lol::*invalid-objects*)
34 (cons (cons attribute c)
35 (gethash object lol::*invalid-objects*)))))))
36 (call-next-method))))
37
38
39(contextl:define-layered-function layered-call-action (action application session frame next-method)
40 (:method (action application session frame next-method)
41 (funcall next-method)))
42
43
44(contextl:define-layered-method layered-call-action
45 :in-layer #.(lol::defining-description 'lol::validate)
46 :around ((action lisp-on-lines-action) application session frame next-method)
47 (call-next-method)
48
49 )
50
51
52
53(defclass described-component-class (described-class standard-component-class )
54 ())
55
56
57
58;; (defcomponent standard-window-component
59;; (ucw-standard::basic-window-component)
60;; ((body
61;; :initform nil
62;; :accessor window-body
63;; :component t
64;; :initarg :body)))
65
66;; (defmethod render-html-head ((window standard-window-component))
67;; (let* ((app (context.application *context*))
68;; (url-prefix (application.url-prefix app)))
69;; (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
70;; (awhen (window-component.title window)
71;; (<:title (if (functionp it)
72;; (funcall it window)
73;; (<:as-html it))))
74;; (awhen (window-component.icon window)
75;; (<:link :rel "icon"
76;; :type "image/x-icon"
77;; :href (concatenate 'string url-prefix it)))
78;; (dolist (stylesheet (effective-window-stylesheets window))
79;; (<:link :rel "stylesheet"
80;; :href stylesheet
81;; :type "text/css"))))
82
83;; (defmethod render-html-body ((window standard-window-component))
84;; (render (window-body window)))
85
86;; (defcomponent info-message ()
87;; ((message :accessor message :initarg :message)))
88
89;; (defmethod render ((m info-message))
90;; (<:div
91;; :class "info-mssage"
92;; (<:as-html (message m)))
93;; (<ucw:a :action (answer-component m nil) "Ok"))
94
95