Fix missing `without-special-symbol-access' in `funcall-with-attribute-context'

[clinton/lisp-on-lines.git] / src / standard-descriptions / t.lisp

diff --git a/src/standard-descriptions/t.lisp b/src/standard-descriptions/t.lisp
index fd8a712..bc2c367 100644 (file)
--- a/src/standard-descriptions/t.lisp
+++ b/src/standard-descriptions/t.lisp
@@ -1,8 +1,18 @@
 (in-package :lisp-on-lines)
 
 (in-package :lisp-on-lines)
 

+(defmethod described-object ((attribute standard-attribute))
+  (described-object (attribute-description attribute)))
+

 (define-description T ()
 (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
    (class :label "Class" :function #'class-of)
    (active-attributes :label "Attributes"
                      :value nil


@@ -17,11 +27,11 @@
                        :activep nil
                        :keyword :activate)
    (inactive-descriptions :label "Inactive Descriptions"
                        :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)
    (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)))
                    :activep nil)
    (value-formatter :value (curry #'format nil "~A")
                    :activep nil)))


@@ -33,27 +43,42 @@
   (:method (attribute)
     (display-using-description attribute *display* (attribute-object attribute))))
 
   (: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-label (attribute)
   (:method (attribute)
     (funcall (attribute-label-formatter attribute) (attribute-label attribute))))
           

-
-

 (define-layered-function display-attribute-value (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)))
   (: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)))
     (let ((val (attribute-value attribute)))

-      (if (eql val (attribute-object attribute))
-         (generic-format *display* (funcall (attribute-value-formatter attribute) val))
+#+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))
+              (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)
          (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* "~A"(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)
 
 (define-layered-method display-using-description 
   ((attribute standard-attribute) display object &rest args)


@@ -62,9 +87,28 @@
     (display-attribute-label attribute))
   (display-attribute-value attribute))
 
     (display-attribute-label attribute))
   (display-attribute-value attribute))
 

+(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))
+   (lambda () 
+     (call-next-method))))
+
+(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)))
 (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 
    (dolist (attribute (rest attributes) (values))
      (generic-format *display* 
       (attribute-value 


@@ -74,7 +118,8 @@
 
 (define-display :around ((description t) (display null) object)
  (with-output-to-string (*standard-output*)
 
 (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)))
+