From e52c58412603bcb1517da095cbbc3ac2dd1d270f Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 29 Jul 2003 20:49:05 +0000 Subject: [PATCH] r5401: *** empty log message *** --- mop.lisp | 28 +++++++++++++++++----------- tests.lisp | 4 ++-- 2 files changed, 19 insertions(+), 13 deletions(-) diff --git a/mop.lisp b/mop.lisp index e42ee8b..817c29c 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.84 2003/07/14 04:10:02 kevin Exp $ +;;;; $Id: mop.lisp,v 1.85 2003/07/29 20:49:05 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -110,6 +110,11 @@ t) (defmethod finalize-inheritance :after ((cl hyperobject-class)) + ;; Work-around needed for OpenMCL + #+ignore + (unless (find-class (class-name cl)) + (setf (find-class (class-name cl)) cl)) + (init-hyperobject-class cl) ) @@ -356,20 +361,20 @@ SQL name" when lazy-reader return it))) (if lazy-reader (setf (slot-value instance slot-name) - (if (atom lazy-reader) - (make-instance lazy-reader) - (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)))) + (if (atom lazy-reader) + (make-instance lazy-reader) + (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 subobj-class reader +(defun ensure-lazy-reader (cl class-name slot-name subobj-class reader &rest reader-keys) - (setf (getf (gethash (find-class class-name) *lazy-readers*) slot-name) + (setf (getf (gethash cl *lazy-readers*) slot-name) (aif subobj-class it (list* reader (copy-list reader-keys))))) @@ -397,7 +402,8 @@ SQL name" :lookup-keys (when (listp subobj-def) (cdr subobj-def))))) (unless (eq (lookup subobject) t) - (apply #'ensure-lazy-reader + (apply #'ensure-lazy-reader + cl (name-class subobject) (name-slot subobject) (subobj-class subobject) (lookup subobject) (lookup-keys subobject)) diff --git a/tests.lisp b/tests.lisp index 6a1853a..48139db 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: tests.lisp,v 1.8 2003/06/17 06:33:54 kevin Exp $ +;;;; $Id: tests.lisp,v 1.9 2003/07/29 20:49:05 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -122,7 +122,7 @@ Fax 123-0005 ") -(deftest p3 (view-to-string mary :category :compact-text-labels) +(deftest p3 (view-to-string mary :vid :compact-text-labels) "Person: first-name Mary last-name Jackson dob Thu, 4 May 2000 03:02:01 resume Style & Grace ") -- 2.34.1