X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fkmr-mop.lisp;h=75ccb5eaa2eacf919f75f5848f66914bd55da5a3;hp=172394017be36062da20cee7c6000cf2b2d43d23;hb=47d5ae2b1454553fa6d71c08862c7dfc5df97a92;hpb=d0f4349abfed43cdb9b618509b8e39579f224326 diff --git a/sql/kmr-mop.lisp b/sql/kmr-mop.lisp index 1723940..75ccb5e 100644 --- a/sql/kmr-mop.lisp +++ b/sql/kmr-mop.lisp @@ -58,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