From 4628b4334da3a1a67a6c38eabc11c4119af671ad Mon Sep 17 00:00:00 2001 From: Drew Crampsie Date: Mon, 4 Jul 2005 00:37:48 -0700 Subject: [PATCH] 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 --- src/backend/clsql.lisp | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) 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 -- 2.20.1