X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/3ca0fb8175991a0cfba941f6f0e691678ed11859..ddf67d6be45e1ea2d58aef8cceeba26f73ed1a0c:/src/standard-descriptions/t.lisp diff --git a/src/standard-descriptions/t.lisp b/src/standard-descriptions/t.lisp index 2f77c47..bc2c367 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 @@ -72,9 +87,10 @@ (display-attribute-label attribute)) (display-attribute-value attribute)) -(define-layered-method display-attribute :around - ((attribute standard-attribute)) - (funcall-with-layer-context +(define-layered-method display-attribute :around ((attribute standard-attribute)) + (with-attribute-context (attribute) + (call-next-method)) + #+nil(funcall-with-layer-context (modify-layer-context (current-layer-context) :activate (attribute-active-descriptions attribute) :deactivate (attribute-inactive-descriptions attribute)) @@ -83,11 +99,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 +118,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))) +