added ROFL test cases + extra formatting hooks for attributes

[clinton/lisp-on-lines.git] / src / description.lisp

diff --git a/src/description.lisp b/src/description.lisp
index d19b92e..710771f 100644 (file)
--- a/src/description.lisp
+++ b/src/description.lisp
@@ -7,26 +7,31 @@
 (defun description-print-name (description)
   (description-class-name (class-of description)))
 
-(defun find-attribute (description attribute-name)
-  (when (slot-exists-p description attribute-name) 
-    (slot-value description attribute-name)))
-
-
 (defun description-attributes (description)
-  (mapcar (curry
-          #'slot-value-using-class 
-          (class-of 'description)
-          description) 
-         (class-slots (class-of description))))
+  (description-class-attributes (class-of description)))
+
+(defun find-attribute (description attribute-name)
+  (find attribute-name (description-attributes description)
+       :key #'attribute-name))
 
+(define-layered-function description-active-descriptions (description)
+  (:method ((description standard-description-object))
+    (attribute-value (find-attribute description 'active-descriptions)))
+  (:method ((description attribute))
+    (attribute-active-descriptions description)))
 
+(define-layered-function description-inactive-descriptions (description)
+  (:method ((description standard-description-object))
+    (attribute-value (find-attribute description 'inactive-descriptions)))
+  (:method ((description attribute))
+    (attribute-inactive-descriptions description)))
 
 (define-layered-function attributes (description)
   (:method (description)
     (let* ((active-attributes 
            (find-attribute description 'active-attributes))
           (attributes (when active-attributes
-            (attribute-value *object* active-attributes))))
+            (attribute-value active-attributes))))
       (if attributes
          (mapcar (lambda (spec)                    
                    (find-attribute