;;;; 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
;;;;
#+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")
(: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
(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)
;;; 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