r5401: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 29 Jul 2003 20:49:05 +0000 (20:49 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 29 Jul 2003 20:49:05 +0000 (20:49 +0000)
mop.lisp
tests.lisp

index e42ee8bfbc991b33ceca85ea3eccd4015a405c54..817c29c159572c366d0f324afaad9895e76d95bb 100644 (file)
--- a/mop.lisp
+++ b/mop.lisp
@@ -11,7 +11,7 @@
 ;;;; 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
@@ -356,20 +361,20 @@ SQL name"
                         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
@@ -397,7 +402,8 @@ SQL name"
                                   :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
index 6a1853a8189386ee4e452fdf89d1eae0ab62c167..48139dbb53fd6c59bdb68eb6bb5edeb15fb823c1 100644 (file)
@@ -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
 ;;;; *************************************************************************
       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
 ")