X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/81d7061052c90867a26b50e69e35f5d96b17686a..6de8d30004efc9337b8c40d2ff2d0a76651d23eb:/src/description-class.lisp

diff --git a/src/description-class.lisp b/src/description-class.lisp
index 5297dfd..0669167 100644
--- a/src/description-class.lisp
+++ b/src/description-class.lisp
@@ -33,7 +33,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defparameter *defined-descriptions* nil))
 
-(defclass description-access-class (standard-layer-class contextl::special-layered-access-class )
+(define-layered-class description-access-class (standard-layer-class contextl::special-layered-access-class )
   ((defined-in-descriptions :initarg :in-description)
    (mixin-class-p :initarg :mixinp)))
 
@@ -68,7 +68,8 @@
             (superclass standard-class))
   t)
 
-(defclass standard-description-object (standard-layer-object) ())
+(defclass standard-description-object (standard-layer-object) 
+  ())
 
 (defun description-class-name  (description-class)
     (read-from-string (symbol-name (class-name description-class))))
@@ -82,7 +83,7 @@
 ;;; For now. --drewc
 
   (pushnew class *defined-descriptions*)
-  
+
 ;;; ENDHACK.
 
   (let* ((description (find-layer class)) 
@@ -107,14 +108,16 @@
 			    (find (slot-definition-name direct-slot) 
 				  attribute-objects 
 				  :key #'attribute-name)))
-		       (dprint "Re-initing")
-		       (apply #'reinitialize-instance attribute 
-			      (print (direct-attribute-properties direct-slot)))
-		       (when (not (eq (find-class (attribute-class attribute))
-				  (class-of attribute)))
+		       (let ((initargs 
+			      (prepare-initargs attribute (direct-attribute-properties direct-slot))))
+			 
+			 (apply #'reinitialize-instance attribute 
+				initargs )
+			 (when (not (eq (find-class (attribute-class attribute))
+					(class-of attribute)))
 			   
 			   (apply #'change-class attribute  (attribute-class attribute) 
-				  (direct-attribute-properties direct-slot)))
+				  initargs)))
 		       
 
 		       (setf (slot-value description (attribute-name attribute))