X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fkmr-mop.lisp;h=75ccb5eaa2eacf919f75f5848f66914bd55da5a3;hb=f5b49cfe271f8c467f74002eaf27e1d93409cdc5;hp=c628dc2d6c98b9079af6884f440ffc48a6801660;hpb=e567409d9fff3f7231c2a0bb69b345e19de2b246;p=clsql.git

diff --git a/sql/kmr-mop.lisp b/sql/kmr-mop.lisp
index c628dc2..75ccb5e 100644
--- a/sql/kmr-mop.lisp
+++ b/sql/kmr-mop.lisp
@@ -7,8 +7,6 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; This file imports MOP symbols into the CLSQL-MOP package and then
 ;;;; re-exports into CLSQL-SYS them to hide differences in
 ;;;; MOP implementations.
@@ -60,6 +58,23 @@
   #+mop-slot-order-reversed (reverse (class-slots class))
   #-mop-slot-order-reversed (class-slots class))
 
+(defun ordered-class-direct-slots (class)
+  "Gets an ordered list of direct class slots"
+  ;; NB: this used to return effective-slot-definitions in direct
+  ;; opposition to the function name.  Not sure why
+  (setf class (to-class class))
+  #+mop-slot-order-reversed (reverse (class-direct-slots class))
+  #-mop-slot-order-reversed (class-direct-slots class))
+
+(defun find-class-slot-by-name (class slot-name &optional direct?)
+  "Looks up a direct-slot-definition by name"
+  (setf class (to-class class))
+  (find (to-slot-name slot-name)
+        (if direct?
+            (ordered-class-direct-slots class)
+            (ordered-class-slots class))
+        :key #'slot-definition-name))
+
 ;; Lispworks has symbol for slot rather than the slot instance
 (defun %svuc-slot-name (slot)
   #+lispworks slot