+(defun set-view-table-slot (class base-table)
+ (setf (view-table class)
+ (table-name-from-arg (or (and base-table
+ (if (listp base-table)
+ (car base-table)
+ base-table))
+ (class-name class)))))
+
+(defgeneric ordered-class-direct-slots (class))
+(defmethod ordered-class-direct-slots ((self standard-db-class))
+ (let ((direct-slot-names
+ (mapcar #'slot-definition-name (class-direct-slots self)))
+ (ordered-direct-class-slots '()))
+ (dolist (slot (ordered-class-slots self))
+ (let ((slot-name (slot-definition-name slot)))
+ (when (find slot-name direct-slot-names)
+ (push slot ordered-direct-class-slots))))
+ (nreverse ordered-direct-class-slots)))
+