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")