r3457: *** empty log message ***

diff --git a/example.lisp b/example.lisp
index cc9883dd4cb7a9555e5631c805581da8209ec9ed..75ef3f7baef8e6d0e804acfa78c892a97b456a13 100644 (file)
--- a/example.lisp
+++ b/example.lisp
@@ -9,13 +9,13 @@
 ;;;;
 ;;;; A simple example file for hyperobjects
 ;;;;
-;;;; $Id: example.lisp,v 1.3 2002/11/22 19:14:17 kevin Exp $
+;;;; $Id: example.lisp,v 1.4 2002/11/22 19:48:49 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
  
-(in-package :hyperobject-mop-user)
+(in-package :hyperobject-user)
 
 
 (defclass person (hyperobject)

diff --git a/hyperobject-no-mop.lisp b/hyperobject-no-mop.lisp
index d0be74c95c84ffb3f184918094f997083acda235..d9f468bca963cf9c6520a9353def551ba85c0fd9 100644 (file)
--- a/hyperobject-no-mop.lisp
+++ b/hyperobject-no-mop.lisp
@@ -9,13 +9,13 @@
 ;;;;
 ;;;; This is a rewrite of hyperobjec't to avoid using metaclasses.
 ;;;;
-;;;; $Id: hyperobject-no-mop.lisp,v 1.1 2002/11/22 15:43:22 kevin Exp $
+;;;; $Id: hyperobject-no-mop.lisp,v 1.2 2002/11/22 19:48:49 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
  
-(in-package :hyperobject)
+(in-package :hyperobject-no-mop)
 
 
 (eval-when (:compile-toplevel :execute)

diff --git a/hyperobject.lisp b/hyperobject.lisp
index 70b67b12271d96f3ea1fba34c4dac73d22db2157..cedfa5e82452c1292e9c6daf9d07b2aace52db37 100644 (file)
--- a/hyperobject.lisp
+++ b/hyperobject.lisp
@@ -11,53 +11,44 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: hyperobject.lisp,v 1.8 2002/11/22 19:14:17 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.9 2002/11/22 19:48:49 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
  
-(in-package :hyperobject-mop)
+(in-package :hyperobject)
 
 (eval-when (:compile-toplevel :execute)
   (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
 
 
-#+allegro
 (shadowing-import
- mop:class-slots mop::slot-definition-name mop:finalize-inheritance
- mop::standard-direct-slot-definition mop::standard-effective-slot-definition
- mop:direct-slot-definition-class mop:compute-effective-slot-definition
- excl::compute-effective-slot-definition-initargs
-)
-
-#+lispworks
-(shadowing-import
- clos:class-slots clos::slot-definition-name clos:finalize-inheritance
- clos::standard-direct-slot-definition clos::standard-effective-slot-definition
- clos:direct-slot-definition-class clos:compute-effective-slot-definition
- clos::compute-effective-slot-definition-initargs
- )
-
+ #+allegro
+ `(mop::class-slots mop::slot-definition-name mop:finalize-inheritance
+   mop::standard-direct-slot-definition mop::standard-effective-slot-definition
+   mop:direct-slot-definition-class mop:compute-effective-slot-definition
+   excl::compute-effective-slot-definition-initargs)
+ #+lispworks
+ `(clos:class-slots clos::slot-definition-name clos:finalize-inheritance
+   clos::standard-direct-slot-definition clos::standard-effective-slot-definition
+   clos:direct-slot-definition-class clos:compute-effective-slot-definition
+   clos::compute-effective-slot-definition-initargs)
+ #+sbcl 
+ `(sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots sb-pcl::standard-class
+   sb-pcl::slot-definition-name sb-pcl:finalize-inheritance
+   sb-pcl::standard-direct-slot-definition
+   sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass
+   sb-pcl:direct-slot-definition-class sb-pcl:compute-effective-slot-definition
+   sb-pcl::compute-effective-slot-definition-initargs)
 #+(or cmu scl)
-(shadowing-import
- pcl:class-of  pcl:class-name pcl:class-slots pcl::standard-class
- pcl::slot-definition-name pcl:finalize-inheritance
- pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition
- pcl::validate-superclass pcl:direct-slot-definition-class
- pcl:compute-effective-slot-definition
- pcl::compute-effective-slot-definition-initargs
-)
-
-#+sbcl
-(shadowing-import
- sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots sb-pcl::standard-class
- sb-pcl::slot-definition-name sb-pcl:finalize-inheritance
- sb-pcl::standard-direct-slot-definition
- sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass
- sb-pcl:direct-slot-definition-class sb-pcl:compute-effective-slot-definition
- sb-pcl::compute-effective-slot-definition-initargs
- )
+`(pcl:class-of  pcl:class-name pcl:class-slots pcl::standard-class
+  pcl::slot-definition-name pcl:finalize-inheritance
+  pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition
+  pcl::validate-superclass pcl:direct-slot-definition-class
+  pcl:compute-effective-slot-definition
+  pcl::compute-effective-slot-definition-initargs)
+ :hyperobject)
 
 ;; Slot definitions
 
@@ -159,14 +150,14 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
       (list name (car value))
       (list name `',value)))
 
-(defmethod (compute-effective-slot-definition) :around
+(defmethod compute-effective-slot-definition :around
     ((cl hyperobject-class) #+(or allegro lispworks) slot dsds)
   (declare (ignorable slot))
   (let* ((dsd (car dsds))
         (ho-type (slot-value dsd 'type)))
     (setf (slot-value dsd 'ho-type) ho-type)
     (setf (slot-value dsd 'type) (convert-ho-type ho-type))
-    (let ((ia (computer-effective-slot-definition-initargs
+    (let ((ia (compute-effective-slot-definition-initargs
               cl #+lispworks slot dsds)))
       (apply
        #'make-instance 'hyperobject-esd 
@@ -219,20 +210,21 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
          (references nil)
          (subobjects nil))
       (declare (ignore classname))
-      
+      (dolist (slot (class-slots cl))
+       (when (slot-value slot 'subobject)
+         (push (make-instance 'subobject :name (slot-definition-name slot)
+                              :reader (if (eq t (esd-subobject slot))
+                                          (slot-definition-name slot)
+                                          (esd-subobject slot)))
+               subobjects)))
+      (setf (slot-value cl 'subobjects) subobjects)
       (dolist (slot-name (slot-value cl 'print-slots))
        (let ((slot (find-slot-by-name cl slot-name)))
          (unless slot
            (error "Slot ~A is not found in class ~S" slot-name cl))
-         (if (slot-value slot 'subobject)
-           (push (make-instance 'subobject :name (slot-definition-name slot)
-                                :reader (if (eq t (esd-subobject slot))
-                                            (slot-definition-name slot)
-                                            (esd-subobject slot)))
-                 subobjects)
-           (let ((name (slot-definition-name slot))
-                 (namestr (symbol-name (slot-definition-name slot)))
-                 (namestr-lower (string-downcase (symbol-name (slot-definition-name slot))))
+         (let ((name (slot-definition-name slot))
+               (namestr (symbol-name (slot-definition-name slot)))
+               (namestr-lower (string-downcase (symbol-name (slot-definition-name slot))))
                  (type (slot-value slot 'ho-type))
                  (formatter (slot-value slot 'format-func))
                  (value-fmt "~a")
@@ -298,10 +290,9 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
          (if (eql type :cdata)
              (setq xmlvalue-func (append xmlvalue-func (list `(xml-cdata ,@plain-value-func))))
              (setq xmlvalue-func (append xmlvalue-func plain-value-func)))
-         ))))
+         )))
 
       (setf (slot-value cl 'references) references)
-      (setf (slot-value cl 'subobjects) subobjects)
       
       (if value-func
          (setq value-func `(lambda (x) (values ,@value-func)))
@@ -823,7 +814,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (print-unreadable-object (obj s :type t :identity t)
     (let ((fmt (make-instance 'hyperobject::textformat)))
       (apply #'format 
-            s (funcall (hyperobject-mop::obj-data-fmtstr fmt) obj)
+            s (funcall (obj-data-fmtstr fmt) obj)
             (multiple-value-list 
-             (funcall (funcall (hyperobject-mop::obj-data-value-func fmt) obj) obj))))))
+             (funcall (funcall (obj-data-value-func fmt) obj) obj))))))
 

diff --git a/no-mop-example.lisp b/no-mop-example.lisp
index c120c21247fa4482d29c77b22434f709e61d7ac7..414acf1529b9be13b9449890b155540291c893d9 100644 (file)
--- a/no-mop-example.lisp
+++ b/no-mop-example.lisp
@@ -11,13 +11,13 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: no-mop-example.lisp,v 1.1 2002/11/22 15:45:06 kevin Exp $
+;;;; $Id: no-mop-example.lisp,v 1.2 2002/11/22 19:48:49 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
  
-(in-package :hyperobject-user)
+(in-package :hyperobject-no-mop-user)
 
 (define-hyperobject person ()
   ((first-name :type string :reference find-person-by-last-name)

diff --git a/package.lisp b/package.lisp
index 61b19e9854f7d030033ab83cef389b465bf2a439..d17b023a1daf363a8c6b168ff0e24517d3269f68 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.6 2002/11/22 15:43:22 kevin Exp $
+;;;; $Id: package.lisp,v 1.7 2002/11/22 19:48:49 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -41,11 +41,11 @@
    ))
 
 (defpackage #:hyperobject-user
-  (:niceknames #:ho-user)
+  (:nicknames #:ho-user)
   (:use #:hyperobject #:cl #:cl-user))
 
 (defpackage #:hyperobject-no-mop-user
-  (:niceknames #:ho-no-mop-user)
+  (:nicknames #:ho-no-mop-user)
   (:use #:hyperobject-no-mop #:cl #:cl-user))