From cb659acb4345ca90e8202c88a66f617de65df2f9 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 28 Apr 2004 15:57:33 +0000 Subject: [PATCH] r9169: allow :metaclass in def-view-class --- ChangeLog | 8 ++++++-- sql/objects.lisp | 10 ++++++---- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 647f6b5..0e0d379 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,13 +1,17 @@ -27 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) +28 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.9.5 * db-mysql/mysql-sql.lisp: Fix bug in transaction capability detection + * sql/objects.lisp: Commit patch from Slawek Zak to allow specifying + :metaclass in DEF-VIEW-CLASS invocation. This allows defining classes + on a metaclass specialized from standard-db-class. + 24 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.9.4: Multiple changes to support Allegro's "modern" lisp which uses a lowercase reader and has case-sensitive symbols * sql/classes.lisp: Fix make-load-form bug for sql-ident-table - exposed by case-sensitive mlisp + exposed by case-sensitive mlisp. 22 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.9.3: All tests now pass on all platforms! diff --git a/sql/objects.lisp b/sql/objects.lisp index a478e0d..d8181d1 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -159,7 +159,7 @@ returns a list of all the classes connected to the default database, ;; Define a new view class ;; -(defmacro def-view-class (class supers slots &rest options) +(defmacro def-view-class (class supers slots &rest cl-options) "Extends the syntax of defclass to allow special slots to be mapped onto the attributes of database views. The macro DEF-VIEW-CLASS creates a class called CLASS which maps onto a database view. Such a @@ -172,9 +172,11 @@ instances are filled with attribute values from the database. If SUPERS is nil then STANDARD-DB-OBJECT automatically becomes the superclass of the newly-defined View Class." `(progn - (defclass ,class ,supers ,slots ,@options - (:metaclass standard-db-class)) - (finalize-inheritance (find-class ',class)))) + (defclass ,class ,supers ,slots + ,@(if (find :metaclass `,cl-options :key #'car) + `,cl-options + (cons '(:metaclass clsql-sys::standard-db-class) `,cl-options))) + (finalize-inheritance (find-class ',class)))) (defun keyslots-for-class (class) (slot-value class 'key-slots)) -- 2.34.1