X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/f4efa7fff2efa6a3144fc664683137df92c42f91..a5a635a2ec9a1187c8ebd30c0baab32dd70bd593:/src/standard-descriptions/t.lisp

diff --git a/src/standard-descriptions/t.lisp b/src/standard-descriptions/t.lisp
index fd8a712..2f77c47 100644
--- a/src/standard-descriptions/t.lisp
+++ b/src/standard-descriptions/t.lisp
@@ -1,8 +1,15 @@
 (in-package :lisp-on-lines)
 
 (define-description T ()
-  ((identity :label nil :function #'identity)
-   (type :label "Type of" :function #'type-of)
+  ((label :label nil 
+	  :function (lambda (object)
+		      (format nil "~@(~A~)" 
+			      (substitute #\Space #\- 
+					  (symbol-name 
+					   (class-name (class-of 
+							object)))))))
+   (identity :label nil :function #'identity)
+   (type :label "Type" :function #'type-of)
    (class :label "Class" :function #'class-of)
    (active-attributes :label "Attributes"
 		      :value nil
@@ -17,11 +24,11 @@
 			:activep nil
 			:keyword :activate)
    (inactive-descriptions :label "Inactive Descriptions"
-			:value nil
-			:activep nil
-			:keyword :deactivate)
+			  :value nil
+			  :activep nil
+			  :keyword :deactivate)
    (label-formatter :value (lambda (label)
-			     (generic-format *display* "~A " label))
+			     (generic-format *display* "~A:" label))
 		    :activep nil)
    (value-formatter :value (curry #'format nil "~A")
 		    :activep nil)))
@@ -33,12 +40,11 @@
   (:method (attribute)
     (display-using-description attribute *display* (attribute-object attribute))))
 
+
 (define-layered-function display-attribute-label (attribute)
   (:method (attribute)
     (funcall (attribute-label-formatter attribute) (attribute-label attribute))))
 	   
-
-
 (define-layered-function display-attribute-value (attribute)
   (:method (attribute)
     (flet ((disp (val &rest args)
@@ -48,12 +54,16 @@
 		    args)))
 	     
     (let ((val (attribute-value attribute)))
-      (if (eql val (attribute-object attribute))
+      (if (and (not (slot-boundp attribute 'active-attributes))
+	       (eql val (attribute-object attribute)))
 	  (generic-format *display* (funcall (attribute-value-formatter attribute) val))
 	  (with-active-descriptions (inline)
-	    (if (slot-boundp attribute 'active-attributes)
-		(disp val :attributes (slot-value attribute 'active-attributes))
-		(disp val))))))))
+	    (cond ((slot-value attribute 'value-formatter)
+		   (generic-format *display* (funcall (attribute-value-formatter attribute) val)))
+		   ((slot-boundp attribute 'active-attributes)
+		    (disp val :attributes (slot-value attribute 'active-attributes)))
+		   (t
+		    (disp val)))))))))
 
 (define-layered-method display-using-description 
   ((attribute standard-attribute) display object &rest args)
@@ -62,6 +72,19 @@
     (display-attribute-label attribute))
   (display-attribute-value attribute))
 
+(define-layered-method display-attribute :around
+  ((attribute standard-attribute))
+    (funcall-with-layer-context 
+   (modify-layer-context (current-layer-context) 
+			 :activate (attribute-active-descriptions attribute)
+			 :deactivate (attribute-inactive-descriptions attribute))
+   (lambda () 
+     (call-next-method))))
+
+(define-layered-method display-attribute :before
+  ((attribute standard-attribute))
+)
+
 (define-display ((description t))
  (let ((attributes (attributes description)))
    (display-attribute (first attributes))
@@ -74,7 +97,8 @@
 
 (define-display :around ((description t) (display null) object)
  (with-output-to-string (*standard-output*)
-   (call-next-layered-method description t object)))		
+   (call-next-layered-method description t object))
+)