Properties are special now!
[clinton/lisp-on-lines.git] / src / ucw / html-description.lisp
1 (in-package :lisp-on-lines)
2
3 (export '(html-description) (find-package :lisp-on-lines))
4
5 (define-description html-description ()
6 ())
7
8
9 (define-description t ()
10 ((css-class :value "lol-description" :activep nil)
11 (dom-id :function (lambda (x)
12 (declare (ignore x))
13 (symbol-name
14 (gensym "DOM-ID-")))
15 :activep nil))
16 (:in-description html-description))
17
18 (define-layered-class html-attribute ()
19 ((css-class :accessor attribute-css-class
20 :initform "lol-attribute")
21 (dom-id :accessor attribute-dom-id :initform nil)))
22
23 (define-layered-class standard-attribute
24 :in-layer #.(defining-description 'html-description)
25 (html-attribute)
26 ())
27
28 (define-layered-function display-html-attribute-label (object attribute)
29 (:method (object attribute)
30 (let ((label (attribute-label attribute)))
31 (<:label
32 :class "lol-attribute-label"
33 (when label
34 (<:as-html
35 (with-output-to-string (*display*)
36 (display-attribute-label object attribute))))))))
37
38 (define-layered-function display-html-attribute-value (object attribute)
39 (:method (object attribute)
40 (<:span
41 :class "lol-attribute-value"
42 (<:as-html (with-output-to-string (*display*)
43 (display-attribute-value object attribute))))
44 ))
45
46 (define-layered-function display-html-attribute (object attribute)
47 (:method (object attribute)
48 (<:div
49 :class (attribute-css-class attribute)
50 (when (attribute-dom-id attribute)
51 :id (attribute-dom-id attribute))
52 (display-html-attribute-label object attribute)
53 (display-html-attribute-value object attribute)
54 (<:br)))
55 (:method :in-layer #.(defining-description 'inline)
56 (object attribute)
57 (<:span
58 :class (attribute-css-class attribute)
59 (when (attribute-dom-id attribute)
60 :id (attribute-dom-id attribute))
61 (display-html-attribute-label object attribute)
62 (<:as-html " ")
63 (display-html-attribute-value object attribute)
64 (<:as-html " "))))
65
66 (define-layered-method display-html-attribute-value
67 :in-layer #.(defining-description 'editable) (object attribute)
68
69 (<:span
70 :class "lol-attribute-value"
71 (if (attribute-editp object attribute)
72 (<lol:input :reader (attribute-value object attribute)
73 :writer (lambda (val)
74 (setf (attribute-value object attribute) val)))
75 (call-next-method))
76 ))
77
78 (define-layered-function display-html-description (description display object)
79 (:method (description display object)
80 (<:style
81 (<:as-html "
82
83 div.lol-description .lol-attribute-label,
84 div.lol-description .lol-attribute-value {
85 display: block;
86 width: 69%;
87 float: left;
88 margin-bottom: 1em;
89
90 }
91 div.lol-description
92 .lol-attribute-label {
93 text-align: right;
94 width: 24%;
95 padding-right: 20px;
96 }
97
98
99 div.lol-description
100 br {
101 clear: left;
102 }"))
103
104 (with-attributes (css-class dom-id) description
105
106
107 (<:div
108 :class (list (attribute-value* css-class) "lol-description" "t")
109 :id (attribute-value* dom-id)
110 (unless *object* (error "Object is nil .. why?"))
111 (dolist (attribute (attributes description))
112 (display-html-attribute *object* attribute))))))
113
114
115 (define-layered-method display-html-description
116 :in-layer #.(defining-description 'inline) (description display object)
117
118 (with-attributes (css-class dom-id) description
119
120
121 (<:span
122 :class (list (attribute-value* css-class) "lol-description")
123 :id (attribute-value* dom-id)
124 (unless *object* (error "Object is nil .. why?"))
125 (dolist (attribute (attributes description))
126 (display-html-attribute *object* attribute))))
127 )
128
129 (define-display
130 :in-description html-description ((description t) (display lol-ucw:component) object )
131 (display-html-description description display object))
132
133
134
135
136