(in-package :lisp-on-lines)
+(defmethod described-object ((attribute standard-attribute))
+ (described-object (attribute-description attribute)))
+
(define-description T ()
((label :label nil
:function (lambda (object)
(funcall (attribute-label-formatter attribute) (attribute-label attribute))))
(define-layered-function display-attribute-value (attribute)
+ (:method-combination arnesi:wrapping-standard)
(:method (attribute)
(flet ((disp (val &rest args)
(apply #'display *display* val
:activate (attribute-active-descriptions attribute)
:deactivate (attribute-inactive-descriptions attribute)
args)))
-
+
+
(let ((val (attribute-value attribute)))
+#+nil (break "display Attribute value: ~A with object ~A ~% Description ~A att-d ~A ~% VALUE ~A display on ~A"
+ attribute
+ (attribute-object attribute)
+ *description*
+ (attribute-description attribute)
+ val
+ *display*
+ )
(if (and (not (slot-boundp attribute 'active-attributes))
- (eql val (attribute-object attribute)))
- (generic-format *display* (funcall (attribute-value-formatter attribute) val))
+ (equal val (attribute-object attribute)))
+ (progn (generic-format *display* "~A"(funcall (attribute-value-formatter attribute) val))
+ #+nil(break "using generic format because val is object and there is no active attributes."))
+
(with-active-descriptions (inline)
(cond ((slot-value attribute 'value-formatter)
- (generic-format *display* (funcall (attribute-value-formatter attribute) val)))
+ (generic-format *display* "~A"(funcall (attribute-value-formatter attribute) val)))
((slot-boundp attribute 'active-attributes)
(disp val :attributes (slot-value attribute 'active-attributes)))
(t
(define-layered-method display-attribute :before
((attribute standard-attribute))
-)
+#+nil (break "Attribute : ~A with object ~A ~% Description ~A att-d ~A"
+ attribute
+ (attribute-object attribute)
+ *description*
+ (attribute-description attribute)
+))
(define-display ((description t))
(let ((attributes (attributes description)))
- (display-attribute (first attributes))
+ (when (first attributes)(display-attribute (first attributes)))
(dolist (attribute (rest attributes) (values))
(generic-format *display*
(attribute-value
(define-display :around ((description t) (display null) object)
(with-output-to-string (*standard-output*)
- (call-next-layered-method description t object))
-)
+ (apply #'call-next-layered-method description t object args)))
+