X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/81d7061052c90867a26b50e69e35f5d96b17686a..4271ab0badc43ec1c9ac5a9f71b8995702802234:/src/standard-descriptions/clos.lisp

diff --git a/src/standard-descriptions/clos.lisp b/src/standard-descriptions/clos.lisp
index ec80d86..2824c2e 100644
--- a/src/standard-descriptions/clos.lisp
+++ b/src/standard-descriptions/clos.lisp
@@ -8,13 +8,29 @@
  ((slot-name :initarg :slot-name :accessor attribute-slot-name)))
 
 (define-layered-method attribute-value (object (attribute slot-definition-attribute))
-  (slot-value object (attribute-slot-name attribute)))
+  (if (slot-boundp object (attribute-slot-name attribute))
+		       
+      (slot-value object (attribute-slot-name attribute))
+      (gensym "UNBOUND-SLOT-")))
+
+(defmacro define-description-for-class (class-name &optional (name (intern (format nil "DESCRIPTION-FOR-~A" class-name))))
+  `(progn 
+     (define-description ,name (standard-object)
+       ,(loop :for slot in (class-slots (find-class class-name))
+	  :collect `(,(slot-definition-name slot) 
+		    :attribute-class slot-definition-attribute
+		    :slot-name ,(slot-definition-name slot)
+		    :label ,(slot-definition-name slot)))
+       (:mixinp t))
+     (unless (ignore-errors (find-description ',class-name))
+       (define-description ,class-name (,name) ()))))
+    
 		       
 		      
 (define-layered-method description-of ((object standard-object))
- (find-description 'standard-object))
-
-
+  (or (ignore-errors (find-description (class-name (class-of object))))
+      (find-description 'standard-object)))
+