X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fmetaclasses.lisp;h=a086288198f03161cfe8ca33cfd0f2a38f1e0054;hp=a43c4acd836381ab77f928401c542aa191717e02;hb=b956c76026d39e3aaa065e64a100e3ad16d03cd5;hpb=e7a214b2445830219022acb5911a3f9303d938bd diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index a43c4ac..a086288 100644 --- a/sql/metaclasses.lisp +++ b/sql/metaclasses.lisp @@ -52,7 +52,7 @@ :accessor view-class-qualifier :initarg :qualifier :initform nil)) - (:documentation "VIEW-CLASS metaclass.")) + (:documentation "Metaclass for all CLSQL View Classes.")) ;;; Lispworks 4.2 and before requires special processing of extra slot and class options @@ -165,11 +165,13 @@ (nth (1+ pos) list))))) (mapcar #'extract keys))) +(defvar *impl-type-attrib-name* #-clisp 'type #+clisp 'clos::$type) + (defun describe-db-layout (class) (flet ((not-db-col (col) (not (member (nth 2 col) '(nil :base :key)))) (frob-slot (slot) - (let ((type (slot-value slot 'type))) + (let ((type (slot-value slot *impl-type-attrib-name*))) (if (eq type t) (setq type nil)) (list (slot-value slot 'name) @@ -281,13 +283,13 @@ column definition in the database.") :initarg :db-constraints :initform nil :documentation - "A single constraint or list of constraints for this column") + "A keyword symbol representing a single SQL column constraint or list of such symbols.") (void-value :accessor view-class-slot-void-value :initarg :void-value :initform nil :documentation - "Value to store is the SQL value is NULL. Default is NIL.") + "Value to store if the SQL value is NULL. Default is NIL.") (db-info :accessor view-class-slot-db-info :initarg :db-info @@ -423,7 +425,7 @@ which does type checking before storing a value in a slot." (car list) list)) -(declaim (inline delistify)) +(declaim (inline delistify-dsd)) (defun delistify-dsd (list) "Some MOPs, like openmcl 0.14.2, cons attribute values in a list." (if (and (listp list) (null (cdr list))) @@ -442,7 +444,7 @@ which does type checking before storing a value in a slot." (null (specified-type dsd))) (setf (specified-type dsd) (slot-definition-type dsd)) - (setf (slot-value dsd 'type) + (setf (slot-value dsd *impl-type-attrib-name*) (compute-lisp-type-from-slot-specification dsd (slot-definition-type dsd))))