(active-attributes :label "Attributes"
:value nil
:activep nil
- :keyword :attributes)))
+ :keyword :attributes)
+ (attribute-delimiter :label "Attribute Delimiter"
+ :value "~%"
+ :activep nil
+ :keyword :delimter)
+ (active-descriptions :label "Active Descriptions"
+ :value nil
+ :activep nil
+ :keyword :activate)
+ (inactive-descriptions :label "Inactive Descriptions"
+ :value nil
+ :activep nil
+ :keyword :deactivate)
+ (label-formatter :value (curry #'format nil "~A "))
+ (value-formatter :value (curry #'format nil "~A"))))
(define-layered-method description-of (any-lisp-object)
(find-description 't))
-(define-layered-function display-attribute (object attribute)
- (:method (object attribute)
- (display-using-description attribute *display* object)))
+(define-layered-function display-attribute (attribute)
+ (:method (attribute)
+ (display-using-description attribute *display* (attribute-object attribute))))
-(define-layered-function display-attribute-label (object attribute)
- (:method (object attribute)
- (format *display* "~A " (attribute-label attribute))))
+(define-layered-function display-attribute-label (attribute)
+ (:method (attribute)
+ (princ (funcall (attribute-label-formatter attribute) (attribute-label attribute))
+ *display*)))
-(define-layered-function display-attribute-value (object attribute)
- (:method (object attribute)
+
+(define-layered-function display-attribute-value (attribute)
+ (: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)))
- (if (eql val object)
- (format *display* "~A " val)
+ (if (eql val (attribute-object attribute))
+ (generic-format *display* (funcall (attribute-value-formatter attribute) val))
(with-active-descriptions (inline)
- (display *display* val))))))
+ (if (slot-boundp attribute 'active-attributes)
+ (disp val :attributes (slot-value attribute 'active-attributes))
+ (disp val))))))))
(define-layered-method display-using-description
((attribute standard-attribute) display object &rest args)
(declare (ignore args))
(when (attribute-label attribute)
- (display-attribute-label object attribute))
- (display-attribute-value object attribute))
+ (display-attribute-label attribute))
+ (display-attribute-value attribute))
(define-display ((description t))
- (format *display* "~{~A~%~}"
- (mapcar
- (lambda (attribute)
- (with-output-to-string (*display*)
- (display-attribute *object* attribute)))
- (attributes description))))
+ (let ((attributes (attributes description)))
+ (display-attribute (first attributes))
+ (dolist (attribute (rest attributes))
+ (generic-format *display*
+ (attribute-value
+ (find-attribute description 'attribute-delimiter)))
+ (display-attribute attribute))))
+
+
+(define-display :around ((description t) (display null))
+ (with-output-to-string (*display*)
+ (print (call-next-method) *display*)))
+