[cells-gtk-cvs] CVS root/gtk-ffi

[pdenno]

Update of /project/cells-gtk/cvsroot/root/gtk-ffi
In directory common-lisp:/tmp/cvs-serv32542/root/gtk-ffi

Modified Files:
	gtk-ffi.lisp 
Log Message:
muffle-warning on style-warning, cffi stuff

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/01/04 16:32:44	1.15
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/11 03:45:55	1.16
@@ -17,7 +17,7 @@
 |#
 
 
-(defpackage :gtk-ffi (:use :common-lisp :ffx :uffi))
+(defpackage :gtk-ffi (:use :common-lisp :uffi))
 
 (in-package :gtk-ffi)
 
@@ -56,10 +56,11 @@
       #+libcellsgtk (:cgtk  "libcellsgtk.dll")))
   (defun load-gtk-libs ()
     (macrolet ((loadit (libname module) 
-		       `(uffi:load-foreign-library 		 
-			 (concatenate 'string cl-user::*gtk-lib-path* ,libname)
-                         :force-load #+lispworks t #-lispworks nil
-			 :module ,(string module))))
+		       `(handler-bind ((style-warning #'muffle-warning))
+			  (uffi:load-foreign-library 		 
+			   (concatenate 'string cl-user::*gtk-lib-path* ,libname)
+			   :force-load #+lispworks t #-lispworks nil
+			   :module ,(string module)))))
       #+(or win32 mswindows)
       (progn 
 	(loadit "libgobject-2.0-0.dll" :gobject)
@@ -136,13 +137,13 @@
                finally (return (list (mapcar 'list gsyms arg$s)
                                  pass-args)))))
       `(progn
-         (uffi:def-function (,gtk-name$ ,gtk-name)
-             ,(mapcar (lambda (name-type)
-                        (destructuring-bind (name type) name-type
-                          (list name (ffi-to-uffi-type type))))
-                arguments)
-           :module ,(string library)
-           :returning ,(ffi-to-uffi-type return-type))
+	  (uffi:def-function (,gtk-name$ ,gtk-name)
+	     ,(mapcar (lambda (name-type)
+			(destructuring-bind (name type) name-type
+			  (list name (ffi-to-uffi-type type))))
+		      arguments)
+	     :module ,(string library)
+	     :returning ,(ffi-to-uffi-type return-type))
          (defun ,name ,(mapcar 'car arguments)
            (when *gtk-debug*
              ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")