4358148e |
1 | (in-package :lisp-on-lines) |
2 | |
81d70610 |
3 | (export '(html-description) (find-package :lisp-on-lines)) |
4358148e |
4 | |
5 | (define-description html-description () |
81d70610 |
6 | ()) |
7 | |
81d70610 |
8 | (define-description t () |
6de8d300 |
9 | ((css-class :value "lol-description" :activep nil) |
4358148e |
10 | (dom-id :function (lambda (x) |
11 | (declare (ignore x)) |
12 | (symbol-name |
6de8d300 |
13 | (gensym "DOM-ID-"))) |
14 | :activep nil)) |
4358148e |
15 | (:in-description html-description)) |
16 | |
17 | (define-layered-class html-attribute () |
18 | ((css-class :accessor attribute-css-class |
19 | :initform "lol-attribute") |
20 | (dom-id :accessor attribute-dom-id :initform nil))) |
21 | |
22 | (define-layered-class standard-attribute |
23 | :in-layer #.(defining-description 'html-description) |
24 | (html-attribute) |
25 | ()) |
26 | |
6de8d300 |
27 | (define-layered-function display-html-attribute-label (object attribute) |
28 | (:method (object attribute) |
29 | (let ((label (attribute-label attribute))) |
30 | (<:label |
31 | :class "lol-attribute-label" |
32 | (when label |
33 | (<:as-html |
34 | (with-output-to-string (*display*) |
35 | (display-attribute-label object attribute)))))))) |
36 | |
37 | (define-layered-function display-html-attribute-value (object attribute) |
38 | (:method (object attribute) |
39 | (<:span |
40 | :class "lol-attribute-value" |
e8d4fa45 |
41 | (<:as-html |
42 | (with-output-to-string (*display*) |
43 | (display-attribute-value object attribute)))) |
6de8d300 |
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 " |
81d70610 |
82 | |
6de8d300 |
83 | div.lol-description .lol-attribute-label, |
84 | div.lol-description .lol-attribute-value { |
81d70610 |
85 | display: block; |
6de8d300 |
86 | width: 69%; |
81d70610 |
87 | float: left; |
6de8d300 |
88 | margin-bottom: 1em; |
81d70610 |
89 | |
90 | } |
6de8d300 |
91 | div.lol-description |
81d70610 |
92 | .lol-attribute-label { |
93 | text-align: right; |
94 | width: 24%; |
95 | padding-right: 20px; |
96 | } |
97 | |
81d70610 |
98 | |
6de8d300 |
99 | div.lol-description |
81d70610 |
100 | br { |
101 | clear: left; |
102 | }")) |
6de8d300 |
103 | |
104 | (with-attributes (css-class dom-id) description |
105 | |
81d70610 |
106 | |
4358148e |
107 | (<:div |
6de8d300 |
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 |
e8d4fa45 |
130 | :in-description html-description ((description t) |
131 | (display lol-ucw:component) |
132 | object) |
6de8d300 |
133 | (display-html-description description display object)) |
4358148e |
134 | |
135 | |
136 | |
137 | |
138 | |