-;; Utilities
-
-(defun my-class-of (obj)
- #-(or cmu sbcl) (class-of obj)
- #+sbcl (sb-pcl:class-of obj)
- #+cmu (pcl:class-of obj))
-
-(defun my-class-name (obj)
- #-(or cmu sbcl) (class-name obj)
- #+sbcl (sb-pcl:class-name obj)
- #+cmu (pcl:class-name obj))
-
-(defun xml-cdata (str)
- (concatenate 'string "<![CDATA[" str "]]>"))
-
-;;
-(defclass ho-class (#-(or cmu sbcl) standard-class
- #+cmu pcl::standard-class
- #+sbcl sb-pcl::standard-class)
- ((title :initarg :title :type string :reader ml-std-title
- :documentation
-"Print Title for class")
- (fields :initarg :fields :reader ml-std-fields
- :documentation
-"List of field lists for printing. Format is
- ((fieldname type optional-formatter) ... )")
- (subobjects-lists
- :initarg :subobjects-lists :reader ml-std-subobjects-lists
- :documentation
-"List of fields that contain a list of subobjects objects.")
- (ref-fields
- :initarg :ref-fields :type list :reader ml-std-ref-field
+#+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
+ )
+
+#+(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
+ )
+
+;; Slot definitions
+
+
+(defclass hyperobject-dsd (standard-direct-slot-definition)
+ ((ho-type :initarg :ho-type :initform nil :accessor dsd-ho-type)
+ (format-func :initarg :format-func :initform nil :accessor dsd-format-func)
+ (subobject :initarg :subobject :initform nil :accessor dsd-subobject)
+ (reference :initarg :reference :initform nil :accessor dsd-reference)
+ ))
+
+(defclass hyperobject-esd (standard-effective-slot-definition)
+ ((ho-type :initarg :ho-type :initform nil :accessor esd-ho-type)
+ (format-func :initarg :format-func :initform nil :accessor esd-format-func)
+ (subobject :initarg :subobject :initform nil :accessor esd-subobject)
+ (reference :initarg :reference :initform nil :accessor esd-reference)
+ ))
+
+;; Main class
+
+(defclass hyperobject-class (standard-class)
+ ((title :initarg :title :type string :initform nil
+ :documentation "Print Title for class")
+ (print-slots :initarg :print-slots :type list :initform nil
+ :documentation "List of slots to print")
+ (subobjects
+ :initarg :subobjects :initform nil
+ :documentation "List of fields that contain a list of subobjects objects.")
+ (references
+ :initarg :references :type list :initform nil