(defvar *escape-html* t)
-(defmethod generic-format ((display lol-ucw:component) string &rest args)
+(defmethod generic-format ((display ucw-core:component) string &rest args)
(<:as-html (with-output-to-string (stream)
(apply #'call-next-method stream string args))))
-
(define-description html-description ()
())
((css-class :accessor attribute-css-class
:initform "lol-attribute")
(dom-id :accessor attribute-dom-id :initform nil)
+ (value-tag :accessor attribute-html-tag :initform nil :initarg :html-tag)
(display-empty-label :accessor attribute-display-empty-label-p :initarg :display-empty-label-p :initform t)))
(define-layered-class standard-attribute
(object attribute)
(let ((label (attribute-label attribute)))
(when label
- (<:as-html
- (with-output-to-string (*display*)
- (display-attribute-label attribute)))))))
+ (<:as-html (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))))
+ :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)
+ :class (format nil "~A lol-attribute" (attribute-css-class attribute))
(when (attribute-dom-id attribute)
:id (attribute-dom-id attribute))
(display-html-attribute-label object attribute)
: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))))
+ (<:span :class "lol-attribute-label"
+ (display-html-attribute-label object attribute))
+ (<:span :class "lol-attribute-value"
+ (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))
+ (declare (ignore args))
(display-html-attribute object attribute))
(apply function args)))))
(defun make-attribute-value-writer (attribute)
- (let ((obj (described-object (attribute-description attribute)))
- (value (attribute-value attribute)))
+ (let ((obj (described-object (attribute-description attribute)))
+ (value (attribute-value attribute))
+ (desc (attribute-description attribute)))
(lambda (val)
- (dletf (((described-object attribute) obj))
+ (dletf (((described-object (attribute-description attribute)) obj))
(with-active-descriptions (editable)
(unless (and (unbound-slot-value-p value)
(equal "" val))
- (setf (attribute-value attribute)
- (parse-attribute-value attribute val))))))))
+ (with-described-object (obj desc)
+ (setf (attribute-value attribute)
+ (parse-attribute-value attribute val)))))))))
(defmethod html-attribute-value (attribute)
val)))
(defmethod display-html-attribute-editor (attribute editor)
- (<lol:input :type "text"
+ (<ucw:input :type "text"
:reader (html-attribute-value attribute)
:writer (make-attribute-value-writer attribute)))
(call-next-method))
(defmethod display-html-attribute-editor (attribute (editor password-attribute-editor))
- (<lol:input :type "password"
+ (<ucw:input :type "password"
:reader (html-attribute-value attribute)
:writer (make-attribute-value-writer attribute)))
-
-
-
(define-layered-method display-attribute-editor
:in-layer #.(defining-description 'html-description) (attribute)
(display-html-attribute-editor attribute (attribute-editor attribute)))
(define-layered-method display-html-attribute-value
:in-layer #.(defining-description 'editable) (object attribute)
-
- (<:td
- :class "lol-attribute-value"
+ #+nil(<:as-html (princ-to-string (attribute-editp attribute)))
(if (attribute-editp attribute)
- (display-attribute-editor attribute)
- (call-next-method))))
+ (<:td
+ :class "lol-attribute-value" (display-attribute-editor attribute))
+ (call-next-method)))
(define-layered-function display-html-description (description display object &optional next-method)
(:method (description display object &optional (next-method #'display-using-description))
- (<:style
- (<:as-html "
-
-
-
-div.lol-description .lol-attribute-label,
-div.lol-description .lol-attribute-value {
- display: block;
- width: 69%;
- float: left;
- margin-bottom: 1em;
-border:1px solid black;
-
-}
-div.lol-description
-.lol-attribute-label {
- text-align: right;
- width: 24%;
- padding-right: 1em;
-}
-
-span.lol-attribute-value .lol-attribute-value (
- border: 1px solid red;}
-
-
-div.lol-description
-br {
-clear: left;
-}
-
-.clear {clear:left}"
-
-))
-
- (with-attributes (css-class dom-id) description
-
-
- (<:table
+ (let ((dom-id (find-attribute description 'dom-id))
+ (css-class (find-attribute description 'dom-id)))
+ (<:table
:class (list (attribute-value css-class) "lol-description" "t")
:id (attribute-value dom-id)
(funcall next-method)
(define-layered-method display-html-description
:in-layer #.(defining-description 'inline) (description display object &optional next-method)
- (with-attributes (css-class dom-id) description
+ (let ((dom-id (find-attribute description 'dom-id))
+ (css-class (find-attribute description 'dom-id)))
(<:span
- :class (list (attribute-value css-class) "lol-description")
- :id (attribute-value dom-id)
- (funcall next-method))))
+ :class (list (attribute-value css-class) "lol-description")
+ :id (attribute-value dom-id)
+ (funcall next-method))))
(define-display
:in-description html-description ((description t)
- (display lol-ucw:component)
+ (display ucw-core:component)
object)
(display-html-description description display object (lambda ()
(call-next-method))))
(when (listp val)
(<:ul
(arnesi:dolist* (item (attribute-value attribute))
- (<:li (apply #'display *display* item (slot-value attribute 'item-args))))))))
\ No newline at end of file
+
+ (dletf (((attribute-object attribute) item))
+ (<:li (apply #'display *display* item (slot-value attribute 'item-args)))))))))
\ No newline at end of file