Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv9071/gtk-ffi
Modified Files: gtk-ffi.lisp Log Message: New method to load foreign libraries. Date: Sun May 29 23:19:58 2005 Author: pdenno
Index: root/gtk-ffi/gtk-ffi.lisp diff -u root/gtk-ffi/gtk-ffi.lisp:1.11 root/gtk-ffi/gtk-ffi.lisp:1.12 --- root/gtk-ffi/gtk-ffi.lisp:1.11 Thu May 5 16:20:51 2005 +++ root/gtk-ffi/gtk-ffi.lisp Sun May 29 23:19:58 2005 @@ -47,85 +47,67 @@
(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(c-null c-null-int int-slot-indexed)) + (export '(c-null c-null-int int-slot-indexed load-gtk-libs)) (defun gtk-function-name (lisp-name) (substitute #_ #- lisp-name)) - - (defun libname (lib) - #+(or win32 mswindows) - (concatenate 'string - "/Program Files/Common Files/GTK/2.0/bin/" - (ecase lib - (:gobject "libgobject-2.0-0.dll") - (:glib "libglib-2.0-0.dll") - (:gthread "libgthread-2.0-0.dll") - (:gdk "libgdk-win32-2.0-0.dll") - (:gtk "libgtk-win32-2.0-0.dll") - (:cgtk "libcellsgtk"))) - #+macosx - (concatenate 'string - "/sw/lib/" - (ecase lib - (:gobject "libgobject-2.0.0.dylib") - (:glib "libglib-2.0.0.dylib") - (:gthread "libgthread-2.0.0.dylib") - (:gdk "libgdk-x11-2.0.0.dylib") - (:gtk "libgtk-x11-2.0.0.dylib") - (:cgtk "libcellsgtk.dylib"))) - #-(or macosx win32 mswindows) - (ecase lib - (:gobject "libgobject-2.0") - (:glib "libglib-2.0") - (:gthread "libgthread-2.0") - (:gdk "libgdk-x11-2.0") - (:gtk "libgtk-x11-2.0") - (:cgtk "libcellsgtk"))) - - - - #+cmu - (loop for lib in '(:gthread :glib :gobject :gdk :gtk #+libcellsgtk :cgtk) - with libpath = (cond ((directory "/usr/lib/libgtk*") "/usr/lib/") - ((directory "/opt/gnome/lib/libgtk*") "/opt/gnome/lib/") - ((find :mswindows *features*) nil) - (t (error "Cannot find a path containing libgtk"))) - do (assert (uffi:load-foreign-library ;;simon - (hic:find-foreign-library (gtk-ffi::libname lib) libpath) - :force-load nil - :module (string lib)))) - - #-libcellsgtk - (warn "libcellsgtk.so not found. Just a few capabilities will be unavailable.") - + (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)))) + #+(or win32 mswindows) + (progn + (loadit "libgobject-2.0-0.dll" :gobject) + (loadit "libglib-2.0-0.dll" :glib) + (loadit "libgthread-2.0-0.dll" :gthread) + (loadit "libgdk-win32-2.0-0.dll" :gdk) + (loadit "libgtk-win32-2.0-0.dll" :gtk) + #+libcellsgtk(loadit "libcellsgtk.dll" :cgtk)) + #+macosx + (progn + (loadit "libgobject-2.0-0.dynlib" :gobject) + (loadit "libglib-2.0-0.dynlib" :glib) + (loadit "libgthread-2.0-0.dynlib" :gthread) + (loadit "libgdk-win32-2.0-0.dynlib" :gdk) + (loadit "libgtk-win32-2.0-0.dynlib" :gtk) + #+libcellsgtk(loadit "libcellsgtk.dynlib" :cgtk)) + #-(or macosx win32 mswindows) + (progn + (loadit "libgobject-2.0.so" :gobject) + (loadit "libglib-2.0.so" :glib) + (loadit "libgthread-2.0.so" :gthread) + (loadit "libgdk-x11-2.0.so" :gdk) + (loadit "libgtk-x11-2.0.so" :gtk) + #+libcellsgtk(loadit "libcellsgtk.so" :cgtk)))) + #+cmu(load-gtk-libs) (defun ffi-to-uffi-type (clisp-type) #+clisp clisp-type #-clisp (if (consp clisp-type) (mapcar 'ffi-to-uffi-type clisp-type) - (case clisp-type - ((nil) :void) - (uint :UNSIGNED-INT) - (c-pointer :pointer-void) - (c-ptr-null '*) - (c-array-ptr '*) - (c-ptr '*) - (c-string :cstring) - (sint32 :int) - (uint32 :unsigned-int) - (uint8 :unsigned-byte) - (uint16 :short) ; no signed/unsigned types? - (boolean :unsigned-int) - (ulong :unsigned-long) - (int :int) - (long :long) - (single-float :float) - (double-float :double) - (otherwise clisp-type)))) - + (case clisp-type + ((nil) :void) + (uint :UNSIGNED-INT) + (c-pointer :pointer-void) + (c-ptr-null '*) + (c-array-ptr '*) + (c-ptr '*) + (c-string :cstring) + (sint32 :int) + (uint32 :unsigned-int) + (uint8 :unsigned-byte) + (uint16 :short) ; no signed/unsigned types? + (boolean :unsigned-int) + (ulong :unsigned-long) + (int :int) + (long :long) + (single-float :float) + (double-float :double) + (otherwise clisp-type)))) #-clisp (defun ffi-to-native-type (ffi-type) (uffi::convert-from-uffi-type - (ffi-to-uffi-type ffi-type) :type))) - + (ffi-to-uffi-type ffi-type) :type))) ;; END eval-when
(defmacro def-gtk-function (library name &key arguments return-type (return-type-allocation :none) @@ -312,13 +294,10 @@ (32 :window_state) (33 :setting)))
- - #-clisp (uffi:def-struct list-boolean (value :unsigned-int) (end :pointer-void)) -
(defmacro with-gtk-string ((var string) &rest body) `(let ((,var ,string))