[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-ffi.lisp

[Peter Denno]

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