X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/4271ab0badc43ec1c9ac5a9f71b8995702802234..b7657b86f85f575d5776dc6b626b1dc258d1fa47:/src/display.lisp

diff --git a/src/display.lisp b/src/display.lisp
index 5888f0b..423ee8c 100644
--- a/src/display.lisp
+++ b/src/display.lisp
@@ -2,17 +2,32 @@
 
 (defvar *description*)
 (defvar *display*)
-(defvar *object*)
-
-(deflayer display-layer)
+(defvar *object* nil)
 
 (define-layered-function display-using-description (description display object &rest args)
   (:documentation
    "Displays OBJECT via description using/in/with/on display"))
 
-(defun display (display object &rest args &key attributes )
-  (let ((*display-attributes* attributes))
-    (display-using-description (description-of object) display object args)))
+
+
+(defun modify-layer-context (context &key activate deactivate)
+  (dolist (d deactivate)
+    (setf context (remove-layer (find-description d)
+				context)))
+  (dolist (d activate context)
+    (setf context (adjoin-layer (find-description d)
+				context))))
+  
+
+
+
+(defun display (display object &rest args &key deactivate activate &allow-other-keys)
+  (funcall-with-layer-context 
+   (modify-layer-context (current-layer-context) 
+			 :activate activate 
+			 :deactivate deactivate)
+   (lambda () 
+     (apply #'display-using-description (description-of object) display object args))))
 
 (define-layered-method display-using-description 
   :around (description display object &rest args)
@@ -20,20 +35,47 @@
   (let ((*description* description)
 	(*display* display)
 	(*object*  object))
-    (call-next-method)))
+;    (<:as-html " " description "Layer Active?: "  (layer-active-p (defining-description 'maxclaims::link-to-viewer)))
+    (dletf (((described-object description) object))
+      (flet ((do-display ()
+	       (contextl::funcall-with-special-initargs  
+		(loop 
+		   :for (key val) :on args :by #'cddr
+		   :collect (list (find key (description-attributes description) 
+					:key #'attribute-keyword)
+				  :value val))
+		(lambda ()
+		  (contextl::funcall-with-special-initargs  
+		   (let ((attribute (ignore-errors (find-attribute description 'active-attributes))))	
+		     (when attribute
+		       (loop for spec in (attribute-value attribute)
+			  if (listp spec)
+			  collect (cons (or 
+					 (find-attribute description (car spec))
+					 (error "No attribute matching ~A" (car spec)))
+					(cdr spec)))))
+		   (lambda () (call-next-method)))))))
+	(funcall-with-layer-context
+	 (modify-layer-context 
+	  (if (standard-description-p description)
+	      (adjoin-layer description (current-layer-context))
+	      (current-layer-context))
+	  :activate (description-active-descriptions description)
+	  :deactivate (description-inactive-descriptions description))
+	 (function do-display))))))
+
 
-(defun display/d (&rest args)
-  (apply #'display-using-description args))
 
 
 
+(defun display/d (&rest args)
+  (apply #'display-using-description args))
+
 (define-layered-method display-using-description (description display object &rest args)
  (error "No DISPLAY-USING-DESCRIPTION methods are specified for: ~%  DESCRIPTION: ~A ~%  DISPLAY: ~A ~%  OBJECT: ~A ~%  ARGS: ~S
 
 OMGWTF! If you didn't do this, it's a bug!" description display object args))
 
-
-
 (defmacro define-display (&body body)
   (loop with in-descriptionp = (eq (car body) :in-description)
 	with description = (if in-descriptionp (cadr body) 't)