From: Drew Crampsie Date: Mon, 4 Jul 2005 07:37:48 +0000 (-0700) Subject: Added the EVAL of the base-class-expander back to def-view-class/meta X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/commitdiff_plain/4628b4334da3a1a67a6c38eabc11c4119af671ad?hp=e8e743d7170e308377c728ab1ce41b752317b1ec;ds=inline Added the EVAL of the base-class-expander back to def-view-class/meta This does not work as a macro as the information it needs is not available at compile time. I've punted to EVAL for now (EVAL'ing a defclass form is not so bad), but a better, most probably MOP based solution will need to be found. darcs-hash:20050704073748-5417e-79ea36affdf24647cfe095d90c9c378491822fc3.gz --- diff --git a/src/backend/clsql.lisp b/src/backend/clsql.lisp index 14f8b15..6de317b 100644 --- a/src/backend/clsql.lisp +++ b/src/backend/clsql.lisp @@ -237,15 +237,20 @@ AND fa.attnum = ANY (pg_constraint.confkey)")) (defmacro def-view-class/meta (name supers slots &rest args) "Create and instrument CLSQL view-class NAME and -appropriate meta-model class(its default name is %NAME-meta-model). -(DEF-VIEW-CLASS/META NAME SUPERS SLOTS &key (MODEL-NAME (intern (format nil \"%~S-META-MODEL\" NAME))) &rest ARGS)." +appropriate meta-model class its default name is %NAME-meta-model." + (let ((model-name (cond ((eq :model-name (car args)) - (pop args) ; remove keyword - (pop args)) ; get value + (pop args) ; remove keyword + (pop args)) ; get value (t (intern (format nil "%~S-META-MODEL" name)))))) + `(progn - (def-meta-model ,model-name ,supers ,slots (:base-type :clsql) ,@args) - (def-base-class ,name (,model-name) ,@args)))) + (let* ((m (def-meta-model ,model-name ,supers ,slots ,args)) + (i (make-instance m))) + (setf (meta-model.base-type i) :clsql) + (prog1 (eval (def-base-class-expander i ',name ',args)) + (defmethod meta-model.metadata ((self ,name)) + (meta-model.metadata i))))))) (defmacro def-view-class/table (table &optional (name (sql->sym table)) model-name) "takes the name of a table as a string and