X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/a5a635a2ec9a1187c8ebd30c0baab32dd70bd593..e8fd1a9a2f3b68a8aee14b8776ff8398ba717eef:/src/standard-descriptions/clos.lisp

diff --git a/src/standard-descriptions/clos.lisp b/src/standard-descriptions/clos.lisp
index 1518392..4bb7abe 100644
--- a/src/standard-descriptions/clos.lisp
+++ b/src/standard-descriptions/clos.lisp
@@ -18,6 +18,24 @@
 	     :accessor attribute-slot-name
 	     :layered t)))
 
+
+(define-layered-method attribute-active-p :around ((attribute slot-definition-attribute))		       
+ (let ((active? (slot-value attribute 'activep)))
+   (if (and (eq :when active?)
+	    (unbound-slot-value-p (attribute-value attribute)))
+       NIL
+       
+       (call-next-method))))
+
+(define-layered-method attribute-active-p 
+ :in-layer #.(defining-description 'editable) 
+ :around ((attribute slot-definition-attribute))		       
+ (let ((active? (slot-value attribute 'activep)))
+   (if (and (eq :when active?)
+	    (unbound-slot-value-p (attribute-value attribute)))
+       t      
+       (call-next-method))))
+
 (defmethod shared-initialize :around ((object slot-definition-attribute) 
 				      slots &rest args)
   (prog1 (call-next-method)