+(define-layered-function display-html-attribute-label (object attribute)
+ (:method (object attribute)
+
+ (let ((label (attribute-label attribute)))
+ (when (or label (attribute-display-empty-label-p attribute))
+ (<:td (<:label
+ :class "lol-attribute-label"
+ (when label
+ (<:as-html
+ (with-output-to-string (*display*)
+ (display-attribute-label attribute)))))))))
+ (:method
+ :in-layer #.(defining-description 'inline)
+ (object attribute)
+ (let ((label (attribute-label attribute)))
+ (when label
+ (<:as-html
+ (with-output-to-string (*display*)
+ (display-attribute-label attribute)))))))
+
+(define-layered-function display-html-attribute-value (object attribute)
+ (:method (object attribute)
+ (<:td
+ :class "lol-attribute-value"
+ (<:as-html
+ (display-attribute-value attribute))))
+
+ (:method
+ :in-layer #.(defining-description 'inline) (object attribute)
+ (display-attribute-value attribute)))
+
+(define-layered-function display-html-attribute (object attribute)
+
+ (:method (object attribute)
+ (<:tr
+ :class (attribute-css-class attribute)
+ (when (attribute-dom-id attribute)
+ :id (attribute-dom-id attribute))
+ (display-html-attribute-label object attribute)
+ (display-html-attribute-value object attribute)))
+
+ (:method
+ :in-layer #.(defining-description 'inline)
+ (object attribute)
+ (<:span
+ :class (attribute-css-class attribute)
+ (when (attribute-dom-id attribute)
+ :id (attribute-dom-id attribute))
+ (display-html-attribute-label object attribute)
+ (display-html-attribute-value object attribute))))
+
+(define-layered-method display-using-description
+ :in-layer #.(defining-description 'html-description)
+ :around ((attribute standard-attribute) display object &rest args)
+ (declare (ignore args))
+ (display-html-attribute object attribute))
+
+
+(defun capture-description (attribute function)
+ (let ((obj (described-object (attribute-description attribute))))
+ (lambda (&rest args)
+ (dletf (((described-object attribute) obj))
+ (apply function args)))))
+
+(defun make-attribute-value-writer (attribute)
+ (let ((obj (described-object (attribute-description attribute)))
+ (value (attribute-value attribute)))
+ (lambda (val)
+ (dletf (((described-object attribute) obj))
+ (with-active-descriptions (editable)
+ (unless (and (unbound-slot-value-p value)
+ (equal "" val))
+ (setf (attribute-value attribute)
+ (parse-attribute-value attribute val))))))))
+
+
+(defmethod html-attribute-value (attribute)
+ (let ((val (attribute-value attribute)))
+ (if (unbound-slot-value-p val)
+ ""
+ val)))
+
+(defmethod display-html-attribute-editor (attribute editor)
+ (<lol:input :type "text"
+ :reader (html-attribute-value attribute)
+ :writer (make-attribute-value-writer attribute)))
+
+(defmethod display-html-attribute-editor ((attribute slot-definition-attribute) editor)
+ (call-next-method))
+
+(defmethod display-html-attribute-editor (attribute (editor password-attribute-editor))
+ (<lol:input :type "password"
+ :reader (html-attribute-value attribute)
+ :writer (make-attribute-value-writer attribute)))
+