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