X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fmetaclasses.lisp;h=1fde1eef9f2319b7045396d3d113b0f51bf1a17a;hb=7b89378f8c7b8437bef05f9b50f3613099ea41c0;hp=61c12e031d532be3787077d00f59fe3010b69205;hpb=30f8208b28a5cbc1a8f8ed759e9c9ac531c93089;p=clsql.git

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index 61c12e0..1fde1ee 100644
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -582,17 +582,31 @@ implementations."
       (ordered-class-direct-slots class)
       (ordered-class-slots class)))
 
+(defun key-slot-p (slot-def)
+  "takes a slot def and returns whether or not it is a key"
+  (eql :key (view-class-slot-db-kind slot-def)))
+
+(defun join-slot-p (slot-def)
+  "takes a slot def and returns whether or not it is a key"
+  (eql :join (view-class-slot-db-kind slot-def)))
+
+(defun key-or-base-slot-p (slot-def)
+  "takes a slot def and returns whether or not it is a key"
+  (member (view-class-slot-db-kind slot-def) '(:key :base)))
+
 (defun direct-normalized-slot-p (class slot-name)
   "Is this a normalized class and if so is the slot one of our direct slots?"
   (setf slot-name (to-slot-name slot-name))
-  (and (normalizedp class)
+  (and (typep class 'standard-db-class)
+       (normalizedp class)
        (member slot-name (ordered-class-direct-slots class)
                :key #'slot-definition-name)))
 
 (defun not-direct-normalized-slot-p (class slot-name)
   "Is this a normalized class and if so is the slot not one of our direct slots?"
   (setf slot-name (to-slot-name slot-name))
-  (and (normalizedp class)
+  (and (typep class 'standard-db-class)
+       (normalizedp class)
        (not (member slot-name (ordered-class-direct-slots class)
                     :key #'slot-definition-name))))