X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=2ccf8d685a106ae8e51f3111781a90b495ce9442;hb=b5ae9d611ffe002ecdb5d19d926b952857cd26c4;hp=18ca5be2d47c575b5e25d42589ceea7c10758552;hpb=4ac9d6f44a5fc2ffa7e723aabbe944ec6d343404;p=hyperobject.git

diff --git a/mop.lisp b/mop.lisp
index 18ca5be..2ccf8d6 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -13,7 +13,7 @@
 ;;;;
 ;;;; $Id$
 ;;;;
-;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg
 ;;;; *************************************************************************
 
 (in-package #:hyperobject)
@@ -112,13 +112,7 @@
   t)
 
 (defmethod finalize-inheritance :after ((cl hyperobject-class))
-  ;; Work-around needed for OpenMCL
-  #+ignore
-  (unless (find-class (class-name cl))
-    (setf (find-class (class-name cl)) cl))
-
-  (init-hyperobject-class cl)
-  )
+  (init-hyperobject-class cl))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (when (>= (length (generic-function-lambda-list
@@ -139,16 +133,16 @@
 	      3)
       (pushnew :ho-normal-esdc cl:*features*)))
 
-;; Slot definitions
 (defmethod direct-slot-definition-class ((cl hyperobject-class)
 					 #+ho-normal-dsdc &rest iargs)
+  (declare (ignore iargs))
   (find-class 'hyperobject-dsd))
 
 (defmethod effective-slot-definition-class ((cl hyperobject-class)
 					    #+ho-normal-esdc &rest iargs)
+  (declare (ignore iargs))
   (find-class 'hyperobject-esd))
 
-
 ;;; Slot definitions
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -234,22 +228,21 @@
      t)))
 
 (defmethod initialize-instance :around ((obj hyperobject-dsd) &rest initargs)
-  (do* ((saved-initargs initargs)
-        (parsed (list obj))
+  (do* ((parsed (list obj))
         (name (first initargs) (first initargs))
         (val (second initargs) (second initargs)))
-      ((null initargs)
-       (apply #'call-next-method parsed))
+       ((null initargs)
+        (apply #'call-next-method parsed))
     (if (eql name :value-type)
         (progn
           (setq val (canonicalize-value-type val))
           (setq parsed (append parsed (list name val)))
           (setq parsed (append parsed (list :type
                                             (value-type-to-lisp-type
-                                             (canonicalize-value-type val))))))
-      (setq parsed (append parsed (list name val))))
+                                               (canonicalize-value-type val))))))
+        (setq parsed (append parsed (list name val))))
     (setq initargs (cddr initargs))))
-  
+
 (defmethod compute-effective-slot-definition :around ((cl hyperobject-class)
 						      #+ho-normal-cesd name
 						      dsds)
@@ -267,7 +260,7 @@
       (setf (esd-sql-length esd) sql-length))
     (setf (esd-user-name esd)
 	  (aif (dsd-user-name dsd)
-	       it
+               it
 	       (string-downcase (symbol-name (slot-definition-name dsd)))))
     (setf (esd-sql-name esd)
 	  (aif (dsd-sql-name dsd)
@@ -278,7 +271,7 @@
 	       it
 	       (lisp-name-to-sql-name (slot-definition-name dsd))))
     (dolist (name '(value-type print-formatter subobject hyperlink
-                    hyperlink-parameters
+                    hyperlink-parameters unbound-lookup
 		    description value-constraint indexed null-allowed
 		    unique short-description void-text read-only-groups
 		    hidden-groups unit disable-predicate view-type
@@ -396,6 +389,7 @@ SQL name"
 ;; is also returned.
 (defun ensure-lazy-reader (cl class-name slot-name subobj-class reader
 			   &rest reader-keys)
+  (declare (ignore class-name))
   (setf (getf (gethash cl *lazy-readers*) slot-name)
     (aif subobj-class
 	 it