| 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 | |