1 (in-package :lisp-on-lines
)
3 (export '(html-description) (find-package :lisp-on-lines
))
5 (defvar *escape-html
* t
)
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
))))
12 (define-description html-description
()
15 (define-description t
()
16 ((css-class :value
"lol-description" :activep nil
)
17 (dom-id :function
(lambda (x)
22 (:in-description html-description
))
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
)))
29 (define-layered-class standard-attribute
30 :in-layer
#.
(defining-description 'html-description
)
34 (define-layered-function display-html-attribute-label
(object attribute
)
35 (:method
(object attribute
)
36 (let ((label (attribute-label attribute
)))
38 :class
"lol-attribute-label"
41 (with-output-to-string (*display
*)
42 (display-attribute-label attribute
)))))))
44 :in-layer
#.
(defining-description 'inline
)
46 (let ((label (attribute-label attribute
)))
49 (with-output-to-string (*display
*)
50 (display-attribute-label attribute
)))))))
52 (define-layered-function display-html-attribute-value
(object attribute
)
53 (:method
(object attribute
)
55 :class
"lol-attribute-value"
57 (display-attribute-value attribute
))))
60 :in-layer
#.
(defining-description 'inline
) (object attribute
)
61 (display-attribute-value attribute
)))
63 (define-layered-function display-html-attribute
(object attribute
)
65 (:method
(object attribute
)
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
)))
74 :in-layer
#.
(defining-description 'inline
)
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
)
81 (display-html-attribute-value object attribute
))))
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
))
90 (defun make-attribute-value-writer (attribute)
91 (let ((obj (described-object (attribute-description attribute
))))
93 (dletf (((described-object attribute
) obj
))
94 (setf (attribute-value attribute
)
95 (parse-attribute-value attribute val
))))))
98 (defmethod display-html-attribute-editor (attribute editor
)
99 (<lol
:input
:type
"text"
100 :reader
(attribute-value attribute
)
101 :writer
(make-attribute-value-writer attribute
)))
103 (defmethod display-html-attribute-editor (attribute (editor password-attribute-editor
))
104 (<lol
:input
:type
"password"
105 :reader
(attribute-value attribute
)
106 :writer
(make-attribute-value-writer attribute
)))
109 (define-layered-method display-attribute-editor
110 :in-layer
#.
(defining-description 'html-description
) (attribute)
111 (display-html-attribute-editor attribute
(attribute-editor attribute
)))
114 (define-layered-method display-html-attribute-value
115 :in-layer
#.
(defining-description 'editable
) (object attribute
)
118 :class
"lol-attribute-value"
119 (if (attribute-editp attribute
)
120 (display-attribute-editor attribute
)
122 (call-next-method))))
124 (define-layered-function display-html-description
(description display object
&optional next-method
)
125 (:method
(description display object
&optional
(next-method #'display-using-description
))
129 div.lol-description .lol-attribute-label,
130 div.lol-description .lol-attribute-value {
138 .lol-attribute-label {
150 (with-attributes (css-class dom-id
) description
154 :class
(list (attribute-value css-class
) "lol-description" "t")
155 :id
(attribute-value dom-id
)
156 (funcall next-method
)))))
159 (define-layered-method display-html-description
160 :in-layer
#.
(defining-description 'inline
) (description display object
&optional next-method
)
161 (with-attributes (css-class dom-id
) description
163 :class
(list (attribute-value css-class
) "lol-description")
164 :id
(attribute-value dom-id
)
165 (funcall next-method
))))
169 :in-description html-description
((description t
)
170 (display lol-ucw
:component
)
172 (display-html-description description display object
(lambda ()
173 (call-next-method))))