;;;; in Text, HTML, and XML formats. This includes hyperlinking\r
;;;; capability and sub-objects.\r
;;;;\r
-;;;; $Id: mop.lisp,v 1.84 2003/07/14 04:10:02 kevin Exp $\r
+;;;; $Id: mop.lisp,v 1.85 2003/07/29 20:49:05 kevin Exp $\r
;;;;\r
;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg\r
;;;; *************************************************************************\r
t)\r
\r
(defmethod finalize-inheritance :after ((cl hyperobject-class))\r
+ ;; Work-around needed for OpenMCL\r
+ #+ignore\r
+ (unless (find-class (class-name cl))\r
+ (setf (find-class (class-name cl)) cl))\r
+ \r
(init-hyperobject-class cl)\r
)\r
\r
when lazy-reader return it)))\r
(if lazy-reader\r
(setf (slot-value instance slot-name)\r
- (if (atom lazy-reader)\r
- (make-instance lazy-reader)\r
- (apply (car lazy-reader)\r
- (loop for arg-slot-name in (cdr lazy-reader)\r
- collect (slot-value instance arg-slot-name)))))\r
- ;; No lazy reader -- defer to regular slot-unbound handling.\r
- (call-next-method))))\r
+ (if (atom lazy-reader)\r
+ (make-instance lazy-reader)\r
+ (apply (car lazy-reader)\r
+ (loop for arg-slot-name in (cdr lazy-reader)\r
+ collect (slot-value instance arg-slot-name)))))\r
+ ;; No lazy reader -- defer to regular slot-unbound handling.\r
+ (call-next-method))))\r
\r
;; The reader is a function and the reader-keys are slot names. The slot is lazily set to\r
;; the result of applying the function to the slot-values of those slots, and that value\r
;; is also returned.\r
-(defun ensure-lazy-reader (class-name slot-name subobj-class reader \r
+(defun ensure-lazy-reader (cl class-name slot-name subobj-class reader \r
&rest reader-keys)\r
- (setf (getf (gethash (find-class class-name) *lazy-readers*) slot-name)\r
+ (setf (getf (gethash cl *lazy-readers*) slot-name)\r
(aif subobj-class\r
it\r
(list* reader (copy-list reader-keys)))))\r
:lookup-keys (when (listp subobj-def)\r
(cdr subobj-def)))))\r
(unless (eq (lookup subobject) t)\r
- (apply #'ensure-lazy-reader \r
+ (apply #'ensure-lazy-reader\r
+ cl\r
(name-class subobject) (name-slot subobject)\r
(subobj-class subobject)\r
(lookup subobject) (lookup-keys subobject))\r