4358148e |
1 | (in-package :lisp-on-lines) |
2 | |
81d70610 |
3 | (export '(html-description) (find-package :lisp-on-lines)) |
4358148e |
4 | |
b7657b86 |
5 | (defvar *escape-html* t) |
6 | |
7 | (defmethod generic-format ((display lol-ucw:component) string &rest args) |
8 | (<:as-html (with-output-to-string (stream) |
9 | (apply #'call-next-method stream string args)))) |
10 | |
11 | |
4358148e |
12 | (define-description html-description () |
81d70610 |
13 | ()) |
14 | |
81d70610 |
15 | (define-description t () |
6de8d300 |
16 | ((css-class :value "lol-description" :activep nil) |
4358148e |
17 | (dom-id :function (lambda (x) |
18 | (declare (ignore x)) |
19 | (symbol-name |
6de8d300 |
20 | (gensym "DOM-ID-"))) |
21 | :activep nil)) |
4358148e |
22 | (:in-description html-description)) |
23 | |
24 | (define-layered-class html-attribute () |
25 | ((css-class :accessor attribute-css-class |
26 | :initform "lol-attribute") |
27 | (dom-id :accessor attribute-dom-id :initform nil))) |
28 | |
29 | (define-layered-class standard-attribute |
30 | :in-layer #.(defining-description 'html-description) |
31 | (html-attribute) |
32 | ()) |
33 | |
6de8d300 |
34 | (define-layered-function display-html-attribute-label (object attribute) |
35 | (:method (object attribute) |
36 | (let ((label (attribute-label attribute))) |
37 | (<:label |
38 | :class "lol-attribute-label" |
39 | (when label |
40 | (<:as-html |
41 | (with-output-to-string (*display*) |
b7657b86 |
42 | (display-attribute-label attribute))))))) |
43 | (:method |
44 | :in-layer #.(defining-description 'inline) |
45 | (object attribute) |
46 | (let ((label (attribute-label attribute))) |
47 | (when label |
48 | (<:as-html |
49 | (with-output-to-string (*display*) |
50 | (display-attribute-label attribute))))))) |
6de8d300 |
51 | |
52 | (define-layered-function display-html-attribute-value (object attribute) |
53 | (:method (object attribute) |
54 | (<:span |
55 | :class "lol-attribute-value" |
e8d4fa45 |
56 | (<:as-html |
b7657b86 |
57 | (display-attribute-value attribute)))) |
58 | |
59 | (:method |
60 | :in-layer #.(defining-description 'inline) (object attribute) |
61 | (display-attribute-value attribute))) |
6de8d300 |
62 | |
63 | (define-layered-function display-html-attribute (object attribute) |
b7657b86 |
64 | |
6de8d300 |
65 | (:method (object attribute) |
b7657b86 |
66 | (<:div |
67 | :class (attribute-css-class attribute) |
68 | (when (attribute-dom-id attribute) |
69 | :id (attribute-dom-id attribute)) |
70 | (display-html-attribute-label object attribute) |
71 | (display-html-attribute-value object attribute))) |
72 | |
73 | (:method |
74 | :in-layer #.(defining-description 'inline) |
75 | (object attribute) |
76 | (<:span |
6de8d300 |
77 | :class (attribute-css-class attribute) |
78 | (when (attribute-dom-id attribute) |
79 | :id (attribute-dom-id attribute)) |
80 | (display-html-attribute-label object attribute) |
b7657b86 |
81 | (display-html-attribute-value object attribute)))) |
82 | |
83 | (define-layered-method display-using-description |
84 | :in-layer #.(defining-description 'html-description) |
85 | :around ((attribute standard-attribute) display object &rest args) |
86 | (declare (ignore args)) |
87 | (display-html-attribute object attribute)) |
88 | |
89 | |
6de8d300 |
90 | |
91 | (define-layered-method display-html-attribute-value |
92 | :in-layer #.(defining-description 'editable) (object attribute) |
93 | |
94 | (<:span |
95 | :class "lol-attribute-value" |
96 | (if (attribute-editp object attribute) |
b7657b86 |
97 | (<lol:input :reader (attribute-value attribute) |
98 | :writer (let ((obj (described-object (attribute-description attribute)))) |
99 | (lambda (val) |
100 | (dletf (((described-object attribute) obj)) |
101 | (setf (attribute-value attribute) val))))) |
6de8d300 |
102 | (call-next-method)) |
103 | )) |
104 | |
b7657b86 |
105 | (define-layered-function display-html-description (description display object &optional next-method) |
106 | (:method (description display object &optional (next-method #'display-using-description)) |
6de8d300 |
107 | (<:style |
108 | (<:as-html " |
81d70610 |
109 | |
6de8d300 |
110 | div.lol-description .lol-attribute-label, |
111 | div.lol-description .lol-attribute-value { |
81d70610 |
112 | display: block; |
6de8d300 |
113 | width: 69%; |
81d70610 |
114 | float: left; |
6de8d300 |
115 | margin-bottom: 1em; |
81d70610 |
116 | |
117 | } |
6de8d300 |
118 | div.lol-description |
81d70610 |
119 | .lol-attribute-label { |
120 | text-align: right; |
121 | width: 24%; |
122 | padding-right: 20px; |
123 | } |
124 | |
81d70610 |
125 | |
6de8d300 |
126 | div.lol-description |
81d70610 |
127 | br { |
128 | clear: left; |
129 | }")) |
6de8d300 |
130 | |
131 | (with-attributes (css-class dom-id) description |
132 | |
81d70610 |
133 | |
4358148e |
134 | (<:div |
b7657b86 |
135 | :class (list (attribute-value css-class) "lol-description" "t") |
136 | :id (attribute-value dom-id) |
137 | (funcall next-method))))) |
6de8d300 |
138 | |
139 | |
140 | (define-layered-method display-html-description |
b7657b86 |
141 | :in-layer #.(defining-description 'inline) (description display object &optional next-method) |
6de8d300 |
142 | (with-attributes (css-class dom-id) description |
6de8d300 |
143 | (<:span |
b7657b86 |
144 | :class (list (attribute-value css-class) "lol-description") |
145 | :id (attribute-value dom-id) |
146 | (funcall next-method)))) |
147 | |
6de8d300 |
148 | |
149 | (define-display |
e8d4fa45 |
150 | :in-description html-description ((description t) |
151 | (display lol-ucw:component) |
152 | object) |
b7657b86 |
153 | (display-html-description description display object (lambda () |
154 | (call-next-method)))) |
155 | |
156 | |
157 | |
158 | |
159 | |
4358148e |
160 | |
161 | |
162 | |
163 | |
164 | |