+cl-kmrcl (1.7-1) unstable; urgency=low
+
+ * Push :kmrcl onto features
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Sun, 13 Oct 2002 20:47:45 -0600
+
cl-kmrcl (1.6-1) unstable; urgency=low
- * Use pcl:class-of for ml-class and CMU
+ * ml-class.lisp: Fix CMUCL compatibility, add SBCL compatibility
-- Kevin M. Rosenberg <kmr@debian.org> Sun, 13 Oct 2002 11:04:04 -0600
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: kmrcl.asd,v 1.7 2002/10/13 17:39:50 kevin Exp $
+;;;; $Id: kmrcl.asd,v 1.8 2002/10/14 07:07:30 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************
#+allegro (require :pxml)
-#+(or allegro lispworks cmu) (require :aserve)
+#+allegro (c-l-c:original-require :aserve)
+#+(or lispworks cmu) (c-l-c:clc-require :aserve)
(in-package :asdf)
(defsystem :kmrcl
+ :perform (load-op :after (op kmrcl)
+ (pushnew :kmrcl cl:*features*))
+
:components
((:file "package")
(:file "genutils" :depends-on ("package"))
(:file "web-utils" :depends-on ("package"))
(:file "xml-utils" :depends-on ("package"))
- #+(or allegro lispworks cmu) (:file "ml-class" :depends-on ("strings" "genutils"))
- (:file "ml" :depends-on ("strings" "genutils"))
+ #+(or allegro lispworks cmu sbcl) (:file "ml-class" :depends-on ("strings" "genutils"))
+ #+ignore (:file "ml" :depends-on ("strings" "genutils"))
#+(or allegro aserve) (:file "web-utils-aserve" :depends-on ("strings" "genutils"))
- )
- )
+ ))
+
+(when (ignore-errors (find-class 'load-compiled-op))
+ (defmethod perform :after ((op load-compiled-op) (c (eql (find-system :kmrcl))))
+ (pushnew :kmrcl cl:*features*)))
;;;; 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