X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=mop.lisp;h=f6bd037d1fb8cba81ba694c2ed969fd2ebd45723;hp=cd7c47736dd6e9d38ccc7ce977a21628bf0ffcb4;hb=888acd079f2e1350ba5f034cb5c93382311e3ff3;hpb=8cba9d956327e3de1e53d5ca58f81da5d6255978

diff --git a/mop.lisp b/mop.lisp
index cd7c477..f6bd037 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
-;;;; $Id: mop.lisp,v 1.18 2003/07/30 19:04:41 kevin Exp $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -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
    )
@@ -53,29 +54,29 @@
 (defun intern-eql-specializer (slot)
   `(eql ,slot))
 
-  (defmacro process-class-option (metaclass slot-name &optional required)
-    #+lispworks
-    `(defmethod clos:process-a-class-option ((class ,metaclass)
-					     (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))
-    #-lispworks
-    (declare (ignore metaclass slot-name required))
-    )
-
-  (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)
-      (list* option `',value already-processed-options))
-    #-lispworks
-    (declare (ignore metaclass slot-name))
-    )
+(defmacro process-class-option (metaclass slot-name &optional required)
+  #+lispworks
+  `(defmethod clos:process-a-class-option ((class ,metaclass)
+                                           (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))
+  #-lispworks
+  (declare (ignore metaclass slot-name required))
+  )
+
+(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)
+    (list* option `',value already-processed-options))
+  #-lispworks
+  (declare (ignore metaclass slot-name))
+  )
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -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