(in-package :lisp-on-lines)
(export '(html-description) (find-package :lisp-on-lines))
(defvar *escape-html* t)
(defmethod generic-format ((display lol-ucw:component) string &rest args)
(<:as-html (with-output-to-string (stream)
(apply #'call-next-method stream string args))))
(define-description html-description ()
())
(define-description t ()
((css-class :value "lol-description" :activep nil)
(dom-id :function (lambda (x)
(declare (ignore x))
(symbol-name
(gensym "DOM-ID-")))
:activep nil))
(:in-description html-description))
(define-layered-class html-attribute ()
((css-class :accessor attribute-css-class
:initform "lol-attribute")
(dom-id :accessor attribute-dom-id :initform nil)
(display-empty-label :accessor attribute-display-empty-label-p :initarg :display-empty-label-p :initform t)))
(define-layered-class standard-attribute
:in-layer #.(defining-description 'html-description)
(html-attribute)
())
(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)
(