projects
/
kmrcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r3017: *** empty log message ***
[kmrcl.git]
/
ml-class.lisp
diff --git
a/ml-class.lisp
b/ml-class.lisp
index b36905507e566d12699aea3f1a6086b112aafd73..ab41de8463afc67f436e4d06bdb974911b3f4f52 100644
(file)
--- 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.
;;;;
;;;; 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:5
0 kevin Exp $
+;;;; $Id: ml-class.lisp,v 1.
8 2002/10/14 07:07:3
0 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;;
;;;; 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))
#+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")
((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
(: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
#+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
#+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
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
t)
#+allegro
@@
-89,13
+93,15
@@
Format is ((field-name field-lookup-func other-link-params) ...)")
(defmethod clos:finalize-inheritance :after ((cl ml-class))
(init-ml-class cl))
(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)
#+lispworks
(defmethod clos:process-a-class-option ((class ml-class)
@@
-296,10
+302,10
@@
Format is ((field-name field-lookup-func other-link-params) ...)")
;;; Class name functions
(defmethod ml-class-stdname ((name string))
;;; 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))
(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
;;;; Generic Print functions