X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/4358148e6c67fcc2ae24050c54d8050b4dc03f9d..81d7061052c90867a26b50e69e35f5d96b17686a:/src/attribute.lisp

diff --git a/src/attribute.lisp b/src/attribute.lisp
index 10bcb70..6d47657 100644
--- a/src/attribute.lisp
+++ b/src/attribute.lisp
@@ -11,7 +11,8 @@
 (define-layered-class effective-attribute-definition-class (special-layered-effective-slot-definition) 
   ((direct-attributes :accessor attribute-direct-attributes)
    (attribute-object :accessor attribute-object
-		     :documentation "")))
+		     :documentation "")
+   (attribute-object-initargs :accessor attribute-object-initargs)))
 
 
 (define-layered-function attribute-value (object attribute))
@@ -39,7 +40,9 @@
    (description-name)
    (description-class :initarg description-class)
    (initfunctions :initform nil)
-   (attribute-class :accessor attribute-class :initarg :attribute-class :initform 'standard-attribute)
+   (attribute-class :accessor attribute-class 
+		    :initarg :attribute-class 
+		    :initform 'standard-attribute)
    (name :layered-accessor attribute-name 
 	  :initarg :name)
    (label :layered-accessor attribute-label 
@@ -140,33 +143,17 @@
 (define-layered-method slot-value-using-layer 
   :in-layer (layer t)
   :around (class (attribute standard-attribute) property reader)
-  ;(dprint "Getting the slot value of ~A" property)
-  
-  (when (not (slot-boundp-using-class class attribute property))
-    ;; If the slot is unbound, we search for its layered-function
-    
-    (let ((fn (property-layered-function 
-	       (attribute-description attribute)
 
-			(attribute-name attribute)
-			(closer-mop:slot-definition-name property))))
-      (dprint ".. not bound yet, have function ~A" fn)
-      (if (generic-function-methods fn)
-	  (let ((*bypass-property-layered-function* t))
-	   ; (dprint " This shit has been bound!. We gona set the _real_ slot to the generic function like.")
-	    (setf (slot-value-using-class class attribute property) fn))
-	  (progn 
-	    ;(dprint "This shit aint never been bound nowhere! checking for initfunction...")
-	    (when (slot-definition-initfunction property)
-	      ;(dprint "At least we have an initfunction. sweeet")
-	      (let ((*bypass-property-layered-function* nil))
-		(setf (slot-value attribute (slot-definition-name property)) 
-		    (funcall (slot-definition-initfunction property)))))))))
-
-  ;(dprint "If we're here, the slot should be bound")
+  ;;  (dprint "Getting the slot value of ~A" property) 
   
-    
-   (if (and 
+  ;; We do some magic in here and i thought it 
+  ;; would be called magically in call-next-method.
+  ;; This explicit call is good enough for now.
+
+  (unless (slot-boundp-using-class class attribute property)
+    (slot-unbound class attribute (slot-definition-name property)))
+
+  (if (and 
        (contextl::slot-definition-layeredp property)
        (not *bypass-property-layered-function*))
       (let ((fn (call-next-method)))
@@ -174,26 +161,33 @@
       (funcall fn layer  (attribute-description attribute)))
       (call-next-method)))
 
+(defmacro define-bypass-function (name function-name)
+  `(defun ,name (&rest args)
+     (let ((*bypass-property-layered-function* t))
+       (apply (function ,function-name) args))))
 
-
-
+(define-bypass-function real-slot-boundp-using-class slot-boundp-using-class)
+(define-bypass-function real-slot-value-using-class slot-value-using-class)
+(define-bypass-function (setf real-slot-value-using-class) (setf slot-value-using-class))
+  
 (defun slot-boundp-using-property-layered-function (class attribute property)
-  (when (not 
-	 (let ((*bypass-property-layered-function* t))
-	   (slot-boundp-using-class class attribute property)))
-    ;; If the slot is unbound, we search for its layered-function
-
-    (let ((fn (property-layered-function 
-	       (attribute-description attribute)
-
+  (dprint "plf boundp:")
+  (let* ((really-bound-p 
+	  (real-slot-boundp-using-class class attribute property))
+	 (fn (if really-bound-p 
+		 (real-slot-value-using-class class attribute property)
+		 (setf (real-slot-value-using-class class attribute property)
+		       (property-layered-function 
+			(attribute-description attribute)
 			(attribute-name attribute)
-			(closer-mop:slot-definition-name property))))
+			(closer-mop:slot-definition-name property))))))
+    (dprint "Slot was bound? ~A" really-bound-p)
+    ;; If the slot is unbound, we search for its layered-function
       (if (generic-function-methods fn)
-	  (let ((*bypass-property-layered-function* t))
-	    (setf (slot-value-using-class class attribute property) fn))
-	  NIL))))
+	  T
+	  NIL)))
     
-#+nil(define-layered-method slot-boundp-using-layer  
+(define-layered-method slot-boundp-using-layer  
   :in-layer (layer t)
   :around (class (attribute standard-attribute) property reader)
   (if *bypass-property-layered-function*