X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=9e2706c9f4477375b3d8dcc5caab573aa0f54813;hb=647d539c69157228c414905a06253e5d3b193718;hp=204412dc39d25f59a844b936b6618320947529c3;hpb=04f829aab1e5caaefe60391f756e7a5db2d1282b;p=hyperobject.git

diff --git a/mop.lisp b/mop.lisp
index 204412d..9e2706c 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: mop.lisp,v 1.70 2003/05/14 05:29:48 kevin Exp $
+;;;; $Id: mop.lisp,v 1.73 2003/05/15 06:30:19 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -371,6 +371,38 @@
 		   ':function (compile nil method-lambda)
 		   init-args-values)))))
 
+#+(or allegro scl)
+(progn
+  ;; One entry for each class with lazy readers defined.  The value is a plist mapping
+  ;; slot-name to a lazy reader, each of which is a list of a function and slot-names.
+  (defvar *lazy-readers* (make-hash-table))
+
+(defmethod slot-unbound :around ((class hyperobject-class) instance slot-name)
+  (let ((lazy-reader (loop for super in (class-precedence-list class)
+			   as lazy-reader = (getf (gethash super *lazy-readers*) slot-name)
+			   when lazy-reader return it)))
+    (if lazy-reader
+	(setf (slot-value instance slot-name)
+	      (apply (car lazy-reader)
+		     (loop for arg-slot-name in (cdr lazy-reader)
+			   collect (slot-value instance arg-slot-name))))
+	;; No lazy reader -- defer to regular slot-unbound handling.
+	(call-next-method))))
+
+  ;; The reader is a function and the reader-keys are slot names.  The slot is lazily set to
+  ;; the result of applying the function to the slot-values of those slots, and that value
+  ;; is also returned.
+  (defun ensure-lazy-reader (class-name slot-name reader &rest reader-keys)
+    (setf (getf (gethash (find-class class-name) *lazy-readers*) slot-name)
+	  (list* reader (copy-list reader-keys))))
+
+  (defun remove-lazy-reader (class-name slot-name)
+    (setf (getf (gethash (find-class class-name) *lazy-readers*) slot-name)
+	  nil))
+  
+  ) ;; #+(or allegro scl)
+
+
 (defun finalize-subobjects (cl)
   "Process class subobjects slot"
   (setf (subobjects cl)
@@ -389,12 +421,12 @@
 						    nil
 						    (cdr subobj-def)))))
 	       (unless (eq (lookup subobject) t)
-		 #-(or sbcl cmu lispworks)
+		 #+ignore ;; #-(or sbcl cmu lispworks)
 		 (eval
 		  `(hyperobject::def-lazy-reader ,(name-class subobject)
 		    ,(name-slot subobject) ,(lookup subobject)
 		    ,@(lookup-keys subobject)))
-		 #+(or sbcl cmu lispworks)
+		 #+(or sbcl cmu lispworks allegro scl)
 		 (apply #'ensure-lazy-reader 
 			(name-class subobject) (name-slot subobject)
 			(lookup subobject) (lookup-keys subobject)))
@@ -419,7 +451,7 @@
 				   (user-name cl))
 		    2)))
 
-  (dolist (name '(description))
+  (dolist (name '(user-name description))
     (awhen (slot-value cl name)
 	   (setf (slot-value cl name)
 		 (etypecase (slot-value cl name)