;;;; in Text, HTML, and XML formats. This includes hyperlinking
;;;; capability and sub-objects.
;;;;
-;;;; $Id: ml-class.lisp,v 1.6 2002/10/13 17:39:50 kevin Exp $
+;;;; $Id: ml-class.lisp,v 1.9 2002/10/14 15:01:17 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: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)
(setq xmlvalue-func (append xmlvalue-func plain-value-func)))
))
- (setq value-func `(lambda (x) (values ,@value-func)))
+ (setq value-func `(lambda () (values ,@value-func)))
(setq value-func (compile nil (eval value-func)))
- (setq xmlvalue-func `(lambda (x) (values ,@xmlvalue-func)))
+ (setq xmlvalue-func `(lambda () (values ,@xmlvalue-func)))
(setq xmlvalue-func (compile nil (eval xmlvalue-func)))
(setf (slot-value cl 'fmtstr-text) fmtstr-text)
;;; 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