1 (in-package :lisp-on-lines
)
3 (export '(html-description) (find-package :lisp-on-lines
))
5 (define-description html-description
()
9 (define-description t
()
10 ((css-class :value
"lol-description" :activep nil
)
11 (dom-id :function
(lambda (x)
16 (:in-description html-description
))
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
)))
23 (define-layered-class standard-attribute
24 :in-layer
#.
(defining-description 'html-description
)
28 (define-layered-function display-html-attribute-label
(object attribute
)
29 (:method
(object attribute
)
30 (let ((label (attribute-label attribute
)))
32 :class
"lol-attribute-label"
35 (with-output-to-string (*display
*)
36 (display-attribute-label object attribute
))))))))
38 (define-layered-function display-html-attribute-value
(object attribute
)
39 (:method
(object attribute
)
41 :class
"lol-attribute-value"
42 (<:as-html
(with-output-to-string (*display
*)
43 (display-attribute-value object attribute
))))
46 (define-layered-function display-html-attribute
(object attribute
)
47 (:method
(object attribute
)
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
)
55 (:method
:in-layer
#.
(defining-description 'inline
)
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
)
63 (display-html-attribute-value object attribute
)
66 (define-layered-method display-html-attribute-value
67 :in-layer
#.
(defining-description 'editable
) (object attribute
)
70 :class
"lol-attribute-value"
71 (if (attribute-editp object attribute
)
72 (<lol
:input
:reader
(attribute-value object attribute
)
74 (setf (attribute-value object attribute
) val
)))
78 (define-layered-function display-html-description
(description display object
)
79 (:method
(description display object
)
83 div.lol-description .lol-attribute-label,
84 div.lol-description .lol-attribute-value {
92 .lol-attribute-label {
104 (with-attributes (css-class dom-id
) description
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
))))))
115 (define-layered-method display-html-description
116 :in-layer
#.
(defining-description 'inline
) (description display object
)
118 (with-attributes (css-class dom-id
) description
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
))))
130 :in-description html-description
((description t
) (display lol-ucw
:component
) object
)
131 (display-html-description description display object
))