X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=ml-class.lisp;h=39878fa91bae69131b19285e8ccac934628d015d;hp=902c1c134422676cd7f62584237e9ffb95337fd2;hb=8127923e06a01790d883aefd282db6c0419c484a;hpb=30c2e8bd2c7043d845024395e19b3030d039eae2 diff --git a/ml-class.lisp b/ml-class.lisp index 902c1c1..39878fa 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.19 2002/10/16 23:34:33 kevin Exp $ +;;;; $Id: ml-class.lisp,v 1.20 2002/10/17 00:25:05 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -25,17 +25,17 @@ (declaim (optimize (speed 3) (safety 1))) (defun ml-class-of (obj) - #-(or cmu sbcl) (class-of obj) + #-(or cmu sbcl scl) (class-of obj) #+sbcl (sb-pcl:class-of obj) - #+cmu (pcl:class-of obj)) + #+(or cmu scl) (pcl:class-of obj)) (defun ml-class-name (obj) - #-(or cmu sbcl) (class-name obj) + #-(or cmu sbcl scl) (class-name obj) #+sbcl (sb-pcl:class-name obj) - #+cmu (pcl:class-name obj)) + #+(or cmu scl) (pcl:class-name obj)) (defclass ml-class (#-(or cmu sbcl) standard-class - #+cmu pcl::standard-class + #+(or cmu scl) pcl::standard-class #+sbcl sb-pcl::standard-class) ((title :initarg :title :type string :reader ml-std-title :documentation @@ -72,7 +72,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (:default-initargs :title nil :fields nil :subobjects-lists nil :ref-fields nil) (:documentation "Metaclass for Markup Language classes.")) -#+cmu +#+(or cmu scl) (defmethod pcl:finalize-inheritance :after ((cl ml-class)) (init-ml-class cl)) @@ -82,7 +82,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (init-ml-class cl)) -#+cmu +#+(or cmu slc) (defmethod pcl:validate-superclass ((class ml-class) (superclass pcl::standard-class)) t) @@ -98,16 +98,6 @@ 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)) -;; (and (not (null (slot-value cl 'pcl::wrapper))) -;; (not (null (slot-value cl 'fmtstr-text))))) - -;;#+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) (name (eql :title))