Fix compilation for Gtk with the new, stricter inheritance

[clg] / gffi / enums.lisp

diff --git a/gffi/enums.lisp b/gffi/enums.lisp
index d97ef70f03aa04a237be6ed2333f9ed9efcc9e81..a762180048f43e7982882df30eeb8e2244580fd4 100644 (file)
--- a/gffi/enums.lisp
+++ b/gffi/enums.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: enums.lisp,v 1.1 2006-04-25 20:37:49 espen Exp $
+;; $Id: enums.lisp,v 1.3 2006-09-05 13:15:46 espen Exp $
 
 (in-package "GFFI")
   
@@ -56,6 +56,10 @@ (define-type-method size-of ((type enum) &key (inlined t))
   (assert-inlined type inlined)
   (size-of 'signed))
 
+(define-type-method type-alignment ((type enum) &key (inlined t))
+  (assert-inlined type inlined)
+  (type-alignment 'signed))
+
 (define-type-method to-alien-form ((type enum) form &optional copy-p)
   (declare (ignore copy-p))
   `(case ,form
@@ -163,8 +167,7 @@ (defun %map-flags (mappings op)
                (:int-symbol `(,value ,symbol)))))
    :key #'first :from-end t))
 
-(deftype flags (&rest args)
-  `(or (member ,@(%map-symbols args)) list))
+(deftype flags (&rest args) (declare (ignore args)) t)
 
 (define-type-method alien-type ((type flags))
   (declare (ignore type))
@@ -174,6 +177,10 @@ (define-type-method size-of ((type flags) &key (inlined t))
   (assert-inlined type inlined)
   (size-of 'unsigned))
 
+(define-type-method type-alignment ((type flags) &key (inlined t))
+  (assert-inlined type inlined)
+  (type-alignment 'unsigned))
+
 (define-type-method to-alien-form ((type flags) flags &optional copy-p)
   (declare (ignore copy-p))
   `(reduce #'logior (mklist ,flags)
@@ -231,8 +238,9 @@ (defmacro define-flags-type (name &rest args)
   (let ((flags-int (intern (format nil "~A-TO-INT" name)))
        (int-flags (intern (format nil "INT-TO-~A" name)))
        (satisfies  (intern (format nil "~A-P" name))))
-    `(progn
-       (deftype ,name () '(satisfies ,satisfies))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+;;        (deftype ,name () '(satisfies ,satisfies))
+       (deftype ,name () '(flags ,@args))
        (defun ,satisfies (object)
         (flet ((valid-p (ob)
                  (find ob ',(%map-symbols args))))
@@ -250,37 +258,39 @@        (defun ,int-flags (value)
          for (int symbol) in ',(%map-flags args :int-symbol)
          when(= (logand value int) int)
          collect symbol))
-       (eval-when (:compile-toplevel :load-toplevel :execute)
-        (define-type-method alien-type ((type ,name))
-          (declare (ignore type))
-          (alien-type 'flags))
-        (define-type-method size-of ((type ,name) &key (inlined t))
-          (assert-inlined type inlined)
-          (size-of 'flags))
-        (define-type-method to-alien-form ((type ,name) form &optional copy-p)
-          (declare (ignore type copy-p))
-          (list ',flags-int form))
-        (define-type-method from-alien-form ((type ,name) form &key ref)
-          (declare (ignore type ref))
-          (list ',int-flags form))
-        (define-type-method to-alien-function ((type ,name) &optional copy-p)
-          (declare (ignore type copy-p))
-          #',flags-int)
-        (define-type-method from-alien-function ((type ,name) &key ref)
-          (declare (ignore type ref))
-          #',int-flags)
-        (define-type-method writer-function ((type ,name) &key temp (inlined t))
-          (declare (ignore temp))
-          (assert-inlined type inlined)
-          (let ((writer (writer-function 'signed)))
-            #'(lambda (flags location &optional (offset 0))
-                (funcall writer (,flags-int flags) location offset))))
-        (define-type-method reader-function ((type ,name) &key ref (inlined t))
-          (declare (ignore ref))
-          (assert-inlined type inlined)
-          (let ((reader (reader-function 'signed)))
-            #'(lambda (location &optional (offset 0))
-                (,int-flags (funcall reader location offset)))))))))
+       (define-type-method alien-type ((type ,name))
+        (declare (ignore type))
+        (alien-type 'flags))
+       (define-type-method size-of ((type ,name) &key (inlined t))
+        (assert-inlined type inlined)
+        (size-of 'flags))
+       (define-type-method type-alignment ((type ,name) &key (inlined t))
+        (assert-inlined type inlined)
+        (type-alignment 'flags))
+       (define-type-method to-alien-form ((type ,name) form &optional copy-p)
+        (declare (ignore type copy-p))
+        (list ',flags-int form))
+       (define-type-method from-alien-form ((type ,name) form &key ref)
+        (declare (ignore type ref))
+        (list ',int-flags form))
+       (define-type-method to-alien-function ((type ,name) &optional copy-p)
+        (declare (ignore type copy-p))
+        #',flags-int)
+       (define-type-method from-alien-function ((type ,name) &key ref)
+        (declare (ignore type ref))
+        #',int-flags)
+       (define-type-method writer-function ((type ,name) &key temp (inlined t))
+        (declare (ignore temp))
+        (assert-inlined type inlined)
+        (let ((writer (writer-function 'signed)))
+          #'(lambda (flags location &optional (offset 0))
+              (funcall writer (,flags-int flags) location offset))))
+       (define-type-method reader-function ((type ,name) &key ref (inlined t))
+        (declare (ignore ref))
+        (assert-inlined type inlined)
+        (let ((reader (reader-function 'signed)))
+          #'(lambda (location &optional (offset 0))
+              (,int-flags (funcall reader location offset))))))))
 
 
 (defexport define-enum-type (name &rest args)