r9169: allow :metaclass in def-view-class

diff --git a/ChangeLog b/ChangeLog
index 647f6b54f76a04091bc89ef74665cc9a20bf2b60..0e0d379c05aad50b1e391ed73b1079d009076841 100644 (file)
--- 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 a478e0d37eb4d49694d0f7bd7256a7838be7dad4..d8181d1fb763b6ae6034cd4a3d7c4a6dc631a4bb 100644 (file)
--- 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))