X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=ml-class.lisp;h=ab41de8463afc67f436e4d06bdb974911b3f4f52;hp=84845b6d573e77cac0d58691280ec097b689ceb0;hb=2993ec50b4caae9675631edc03b5298610a67372;hpb=a021c083c78592e9e8135418821b7f32daa04f79

diff --git a/ml-class.lisp b/ml-class.lisp
index 84845b6..ab41de8 100644
--- a/ml-class.lisp
+++ b/ml-class.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: ml-class.lisp,v 1.7 2002/10/13 23:08:40 kevin Exp $
+;;;; $Id: ml-class.lisp,v 1.8 2002/10/14 07:07:30 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -29,7 +29,9 @@
   #+sbcl (sb-pcl:class-of obj)
   #+cmu (pcl:class-of obj))
 
-(defclass ml-class (standard-class)
+(defclass ml-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")
@@ -66,19 +68,21 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (:documentation "Metaclass for Markup Language classes."))
 
 #+cmu
-(defmethod pcl:validate-superclass ((class ml-class) (superclass pcl::standard-class))
-  t)
+(defmethod pcl:finalize-inheritance :after ((cl ml-class))
+  (init-ml-class cl))
+
 
 #+sbcl
-(defmethod sb-pcl:validate-superclass ((class ml-class) (superclass sb-pcl::standard-class))
-  t)
+(defmethod sb-pcl:finalize-inheritance :after ((cl ml-class))
+  (init-ml-class cl))
+
 
 #+cmu
-(defmethod pcl:validate-superclass ((class pcl::standard-class) (superclass ml-class))
+(defmethod pcl:validate-superclass ((class ml-class) (superclass pcl::standard-class))
   t)
 
 #+sbcl
-(defmethod sb-pcl:validate-superclass ((class sb-pcl::standard-class) (superclass ml-class))
+(defmethod sb-pcl:validate-superclass ((class ml-class) (superclass sb-pcl::standard-class))
   t)
 
 #+allegro
@@ -89,19 +93,15 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 (defmethod clos:finalize-inheritance :after ((cl ml-class))
   (init-ml-class cl))
 
-#+cmu
-(defmethod pcl::class-finalized-p ((cl ml-class))
-  (with-slots (wrapper fmtstr-text) cl
-      (and (not (null wrapper))
-	   (not (null fmtstr-text)))))
-
-#+cmu
-(defmethod pcl:finalize-inheritance :after ((cl ml-class))
-  (init-ml-class cl))
+;;#+cmu
+;;(defmethod pcl::class-finalized-p ((cl ml-class))
+;;  (and (not (null (slot-value cl 'pcl::wrapper)))
+;;       (not (null (slot-value cl 'fmtstr-text)))))
 
-#+sbcl
-(defmethod sb-pcl:finalize-inheritance :after ((cl ml-class))
-  (init-ml-class cl))
+;;#+sbcl
+;;(defmethod sb-pcl::class-finalized-p ((cl ml-class))
+;;  (and (not (null (slot-value cl 'sb-pcl::wrapper)))
+;;       (not (null (slot-value cl 'fmtstr-text)))))
 
 #+lispworks
 (defmethod clos:process-a-class-option ((class ml-class)
@@ -302,10 +302,10 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 ;;; Class name functions
 
 (defmethod ml-class-stdname ((name string))
-  (string-downcase (subseq name :start 1)))
+  (string-downcase (subseq name 1)))
   
 (defmethod ml-class-stdname ((cl standard-object))
-  (string-downcase (subseq (class-name (ml-class-of cl)) :start 1)))
+  (string-downcase (subseq (class-name (ml-class-of cl)) 1)))
   
 ;;;; Generic Print functions