X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fmetaclasses.lisp;h=1fde1eef9f2319b7045396d3d113b0f51bf1a17a;hp=61c12e031d532be3787077d00f59fe3010b69205;hb=39e2802cd264ddacb3ca59b3b2c5c38f202149de;hpb=f5b49cfe271f8c467f74002eaf27e1d93409cdc5 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))))