X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/3ca0fb8175991a0cfba941f6f0e691678ed11859..7aeb0a9093d5bc2e0695fa003205b39dad67d967:/src/standard-descriptions/t.lisp diff --git a/src/standard-descriptions/t.lisp b/src/standard-descriptions/t.lisp index 2f77c47..3256903 100644 --- a/src/standard-descriptions/t.lisp +++ b/src/standard-descriptions/t.lisp @@ -1,5 +1,8 @@ (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) @@ -46,20 +49,32 @@ (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 @@ -83,11 +98,16 @@ (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 @@ -97,8 +117,8 @@ (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))) +