new version 1.98

[kmrcl.git] / mop.lisp

diff --git a/mop.lisp b/mop.lisp
index 8decec559d7ec7330ac0e79202d4817b53da800c..f6bd037d1fb8cba81ba694c2ed969fd2ebd45723 100644 (file)
--- a/mop.lisp
+++ b/mop.lisp
@@ -30,7 +30,7 @@
 #+cmu
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (if (eq (symbol-package 'pcl:find-class)
-         (find-package 'common-lisp))
+          (find-package 'common-lisp))
       (pushnew :kmr-cmucl-mop cl:*features*)
       (pushnew :kmr-cmucl-pcl cl:*features*)))
 
@@ -42,6 +42,7 @@
    #+kmr-cmucl-mop #:mop
    #+allegro #:mop
    #+lispworks #:clos
+   #+clisp #:clos
    #+scl #:clos
    #+openmcl #:openmcl-mop
    )
@@ -56,8 +57,8 @@
 (defmacro process-class-option (metaclass slot-name &optional required)
   #+lispworks
   `(defmethod clos:process-a-class-option ((class ,metaclass)
-                                          (name (eql ,slot-name))
-                                          value)
+                                           (name (eql ,slot-name))
+                                           value)
     (when (and ,required (null value))
       (error "metaclass ~A class slot ~A must have a value" (quote ,metaclass) name))
     (list name `',value))
@@ -68,10 +69,10 @@
 (defmacro process-slot-option (metaclass slot-name)
   #+lispworks
   `(defmethod clos:process-a-slot-option ((class ,metaclass)
-                                         (option (eql ,slot-name))
-                                         value
-                                         already-processed-options
-                                         slot)
+                                          (option (eql ,slot-name))
+                                          value
+                                          already-processed-options
+                                          slot)
     (list* option `',value already-processed-options))
   #-lispworks
   (declare (ignore metaclass slot-name))
@@ -84,6 +85,8 @@
    '(excl::compute-effective-slot-definition-initargs)
    #+lispworks
    '(clos::compute-effective-slot-definition-initargs)
+   #+clisp
+   '(clos::compute-effective-slot-definition-initargs)
    #+sbcl
    '(#+kmr-sbcl-mop class-of #-kmr-sbcl-mop sb-pcl:class-of
      #+kmr-sbcl-mop class-name #-kmr-sbcl-mop sb-pcl:class-name
@@ -140,45 +143,45 @@
      openmcl-mop:class-prototype openmcl-mop:generic-function-method-class openmcl-mop:intern-eql-specializer
      openmcl-mop:make-method-lambda openmcl-mop:generic-function-lambda-list
      openmcl-mop::compute-slots)   ))
-  
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (export '(class-of class-name class-slots find-class
-           standard-class
-           slot-definition-name finalize-inheritance
-           standard-direct-slot-definition
-           standard-effective-slot-definition validate-superclass
-           compute-effective-slot-definition-initargs
-           direct-slot-definition-class effective-slot-definition-class
-           compute-effective-slot-definition
-           slot-value-using-class
-           class-prototype generic-function-method-class intern-eql-specializer
-           make-method-lambda generic-function-lambda-list
-           compute-slots
-           class-direct-slots
-           ;; KMR-MOP encapsulating macros
-           process-slot-option
-           process-class-option))
-  
+            standard-class
+            slot-definition-name finalize-inheritance
+            standard-direct-slot-definition
+            standard-effective-slot-definition validate-superclass
+            compute-effective-slot-definition-initargs
+            direct-slot-definition-class effective-slot-definition-class
+            compute-effective-slot-definition
+            slot-value-using-class
+            class-prototype generic-function-method-class intern-eql-specializer
+            make-method-lambda generic-function-lambda-list
+            compute-slots
+            class-direct-slots
+            ;; KMR-MOP encapsulating macros
+            process-slot-option
+            process-class-option))
+
   #+sbcl
   (if (find-package 'sb-mop)
       (setq cl:*features* (delete :kmr-sbcl-mop cl:*features*))
       (setq cl:*features* (delete :kmr-sbcl-pcl cl:*features*)))
-  
+
   #+cmu
   (if (find-package 'mop)
       (setq cl:*features* (delete :kmr-cmucl-mop cl:*features*))
       (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*)))
-  
+
   (when (>= (length (generic-function-lambda-list
-                    (ensure-generic-function
-                     'compute-effective-slot-definition)))
-           3)
+                     (ensure-generic-function
+                      'compute-effective-slot-definition)))
+            3)
     (pushnew :kmr-normal-cesd cl:*features*))
-  
+
   (when (>= (length (generic-function-lambda-list
-                    (ensure-generic-function
-                     'direct-slot-definition-class)))
-           3)
+                     (ensure-generic-function
+                      'direct-slot-definition-class)))
+            3)
     (pushnew :kmr-normal-dsdc cl:*features*))
 
   )  ;; eval-when